Question

excel VBA合并单元格批量插入图片

如图无规律行数合并的单元格怎么用VBA代码在C列根据B列的名称批量插入图片并且图片根据合并单元格大小填充！！！

Answer 1

新建一个按键或是新建宏，代码如下：

Private Sub CommandButton1_Click()
    Dim rng As Range
    Dim s As String
    On Error Resume Next
    For Each Shp In ActiveSheet.Shapes
        Set rng = Shp.TopLeftCell
        If rng.Column = 3 Then
            If Shp.Type = msoPicture Then Shp.Delete
        End If
    Next
    For i = 2 To 20
        If Cells(i, 2).MergeCells = True Then
           h = Cells(i, 2).MergeArea.Rows.Count
        Else
           h = 1
        End If
        If Cells(i, 2).MergeArea.Row = i Then
            s = ThisWorkbook.Path & "\" & Cells(i, 2).Value & ".jpg"
            If Dir(s) <> "" Then
                Set rng = Range("c" & i & ":C" & i + h - 1)
                rng.Select
                Dim MyFile As Object
                Set MyFile = CreateObject("Scripting.FileSystemObject")
                If MyFile.FileExists(s) = False Then
                    MsgBox s & "图片不存在"
                Else
                '在选定的单元格中插入图片
                    With Sheets(1).Pictures.Insert(s)
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Placement = xlMoveAndSize
                        .ShapeRange.Left = rng.Left
                        .ShapeRange.Top = rng.Top
                        .ShapeRange.Height = rng.Height
                        .ShapeRange.Width = rng.Width
                    End With
                End If
            End If
        End If
    Next
End Sub

中午回答时违规了，有疑问：叁陆要是零八玖救陆。

追问

高手，谢谢，希望后有VBA方面的能再次请教。

Answer 2

引用QQ361408996的回答：
新建一个按键或是新建宏，代码如下：
Private Sub CommandButton1_Click() Dim rng As Range Dim s As String On Error Resume Next For Each Shp In ActiveSheet.Shapes Set rng = Shp.TopLeftCell If rng.Column = 3 Then If Shp.Type = msoPicture Then Shp.Delete End If Next For i = 2 To 20 If Cells(i, 2).MergeCells = True Then h = Cells(i, 2).MergeArea.Rows.Count Else h = 1 End If If Cells(i, 2).MergeArea.Row = i Then s = ThisWorkbook.Path & "\" & Cells(i, 2).Value & ".jpg" If Dir(s) <> "" Then Set rng = Range("c" & i & ":C" & i + h - 1) rng.Select Dim MyFile As Object Set MyFile = CreateObject("Scripting.FileSystemObject") If MyFile.FileExists(s) = False Then MsgBox s & "图片不存在" Else '在选定的单元格中插入图片 With Sheets(1).Pictures.Insert(s) .ShapeRange.LockAspectRatio = msoFalse .Placement = xlMoveAndSize .ShapeRange.Left = rng.Left .ShapeRange.Top = rng.Top .ShapeRange.Height = rng.Height .ShapeRange.Width = rng.Width End With End If End If End If NextEnd Sub
中午回答时违规了，有疑问：叁陆要是零八玖救陆。

vba里不需要选择图片位置吗