怎样使用VBA在工作表单元格中批量插入图片？

1、首先在开发工具中打开VBA编辑器

2、在单元格区域当中输入一些内容作为例子

3、在VBA编辑器中插入模块

4、在模块当中输入如下代码，然后运行

Sub insertpic()

 

    Dim i As Integer

 

    Dim filpath As String

 

    Dim rng As Range

 

    Dim s As String

 

    With Sheet3

 

        'For i = 1 To .Range("a1000").End(xlUp).Row         '循环的值由A列行数决定

 

        For i = 1 To 5

 

        'filpath = ThisWorkbook.Path & "\" & .Cells(i, 1).Text & ".jpg"          '图片路径

 

        filpath = "E:\02" & "\" & .Cells(i, 1).Text & ".jpg"

 

            If Dir(filpath) <> "" Then          '查找名字相同并插入图片，列出图片名字

 

                .Pictures.Insert(filpath).Select            '选择插入的图片

 

                Selection.ShapeRange.LockAspectRatio = msoFalse

 

                'Set rng = .Cells(i, 3)         '设置图片插入的位置，第三列

 

                Set rng = .Range("C" & (i) & ":D" & (i))

 

                        With Selection

 

                            .Top = rng.Top + 5

 

                            .Left = rng.Left + 5

 

                            .Width = rng.Width - 10

 

                            .Height = rng.Height - 10

 

                        End With

 

'                Set rg = rng.TopLeftCell

 

'                    If rg.MergeCells = True Then

 

'                        With Selection

 

'                            .Top = rg.MergeCell.Top + 5

 

'                            .Left = rg.MergeCell.Left + 5

 

'                            .Width = rg.MergeCell.Width - 10

 

'                            .Height = rg.MergeCell.Height - 10

 

'                        End With

 

'                    Else

 

'                        With Selection

 

'                            .Top = rg.Top + 5

 

'                            .Left = rg.Left + 5

 

'                            .Width = rg.Width - 10

 

'                            .Height = rg.Height - 10

 

'                        End With

 

'                    End If

 

             Else

 

                s = s & Chr(10) & .Cells(i, 1).Text

 

             End If

 

        Next

 

        .Cells(1, 1).Select

 

    End With

 

    If s <> "" Then

 

        MsgBox s & Chr(10) & "没有照片"

 

    End If

 

 End Sub

5、最后我们就可以看到在工作表的第3列当中自动批量图片，