Excel批量導入圖片到指定單元格

一、從excel圖片批量嵌入單元格

在Excel中，我們可以將圖片嵌入單元格中，這樣可以保證圖片與單元格的對應關係，也方便對單元格和圖片的移動和複製。

Sub Insert_Picture_Into_Cell()
    Dim strPic As String
    strPic = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp), *.gif;*.jpg;*.bmp", MultiSelect:=True)
    If strPic = "False" Then Exit Sub
    Dim cell As Range
    For Each cell In Selection
        If cell.Row = ActiveCell.Row Then
            cell.Select
            If Len(strPic) > 0 Then
                cell.Activate
                ActiveSheet.Pictures.Insert(strPic).Select
                With Selection.ShapeRange
                    .LockAspectRatio = msoTrue
                    .Width = cell.Width - 2
                    .Height = cell.Height - 2
                    .Top = cell.Top + 1
                    .Left = cell.Left + 1
                End With
            End If
        End If
    Next
End Sub

二、Excel批量導入多張圖片並自動排版

如果我們需要一次性導入多張圖片並自動排版，可以使用以下代碼：

Sub Insert_Multiple_Pictures()
    Dim strPath As String
    strPath = "C:\Pictures\" '圖片所在文件夾路徑
    Dim imgExtension As String
    imgExtension = "*.jpg" '圖片擴展名
    Dim rowIndex As Integer
    rowIndex = 1 '從第一行開始插入圖片
    Dim colIndex As Integer
    colIndex = 1 '從第一列開始插入圖片
    Dim picTop As Double
    picTop = Cells(rowIndex, colIndex).Top '圖片頂部位置
    Dim picLeft As Double
    picLeft = Cells(rowIndex, colIndex).Left '圖片左側位置
    Dim picWidth As Double
    picWidth = Cells(rowIndex, colIndex).Width '圖片寬度
    Dim picHeight As Double
    picHeight = Cells(rowIndex, colIndex).Height '圖片高度
    Dim imgCount As Integer
    imgCount = 0 '已插入圖片數量
    Dim pic As Picture
    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic
    Dim strFile As String
    strFile = Dir(strPath & imgExtension)
    Do While Len(strFile) > 0
        Set pic = ActiveSheet.Pictures.Insert(strPath & strFile)
        pic.Top = picTop
        pic.Left = picLeft
        pic.Width = picWidth
        pic.Height = picHeight
        If colIndex  20 Then Exit Do '插入圖片20張後退出
        picTop = Cells(rowIndex, colIndex).Top
        picLeft = Cells(rowIndex, colIndex).Left
        picWidth = Cells(rowIndex, colIndex).Width
        picHeight = Cells(rowIndex, colIndex).Height
        strFile = Dir
        imgCount = imgCount + 1
    Loop
    MsgBox imgCount & "張圖片已成功導入到Excel中！"
End Sub

三、Excel批量導入對應圖片

如果我們有一份表格，需要根據表格中每行數據對應的圖片來批量導入圖片，可以使用以下代碼：

Sub Insert_Picture_By_Match()
    Dim strPath As String
    strPath = "C:\Pictures\" '圖片所在文件夾路徑
    Dim imgExtension As String
    imgExtension = "*.jpg" '圖片擴展名
    Dim picTop As Double
    picTop = 0 '圖片頂部位置
    Dim picLeft As Double
    picLeft = 0 '圖片左側位置
    Dim picWidth As Double
    picWidth = 100 '圖片寬度
    Dim picHeight As Double
    picHeight = 100 '圖片高度
    Dim i As Integer
    Dim j As Integer
    Dim strFile As String
    strFile = Dir(strPath & imgExtension)
    For i = 2 To 10 '從第2行開始
        picTop = ActiveSheet.Cells(i, 3).Top '圖片所在行第3列
        picLeft = ActiveSheet.Cells(i, 4).Left '圖片所在行第4列
        strFile = Dir(strPath & Left(ActiveSheet.Cells(i, 5).Value, 3) & imgExtension) '根據數據中的名稱匹配圖片
        Set pic = ActiveSheet.Pictures.Insert(strPath & strFile)
        pic.Top = picTop
        pic.Left = picLeft
        pic.Width = picWidth
        pic.Height = picHeight
    Next i
    MsgBox "圖片已成功導入到Excel中！"
End Sub

四、Excel中快速批量導入圖片

如果我們只需要快速地將圖片批量導入到Excel中，可以使用以下方法：

在Excel中，我們可以直接通過複製粘貼的方式將圖片導入到單元格中。

步驟如下：

1.打開圖片文件夾和Excel表格文件，分別在Windows資源管理器和Excel中選中需要導入圖片的單元格；

2.在資源管理器中選中需要導入的圖片文件，使用Ctrl+C複製或者右鍵菜單複製；

3.在Excel表格中單擊需要導入圖片的單元格，使用Ctrl+V粘貼或者右鍵菜單粘貼。

五、Excel批量導入圖片對應名稱

如果我們有一批圖片，需要將圖片名稱對應到Excel表格中的姓名列，可以使用以下代碼：

Sub Insert_Picture_By_Name()
    Dim strPath As String
    strPath = "C:\Pictures\" '圖片所在文件夾路徑
    Dim imgExtension As String
    imgExtension = "*.jpg" '圖片擴展名
    Dim imgCount As Integer
    imgCount = 0 '導入圖片數量
    Dim strFile As String
    strFile = Dir(strPath & imgExtension)
    Dim r As Range
    For Each r In ActiveSheet.Range("A1:A10") '以A1:A10範圍內的姓名為圖片名稱
        strFile = Dir(strPath & Left(r.Value, 3) & imgExtension)
        Set pic = ActiveSheet.Pictures.Insert(strPath & strFile)
        pic.Top = r.Top
        pic.Left = r.Left + r.Width + 5 '將圖片放在姓名列的右側5個單元格
        pic.Width = 100
        pic.Height = 100
        imgCount = imgCount + 1
    Next r
    MsgBox imgCount & "張圖片已成功導入到Excel中！"
End Sub

六、Excel批量導入圖片按姓名並選取

如果我們需要將圖片按姓名進行導入，並且可以手動選取圖片，可以使用以下代碼：

Sub Insert_Picture_By_Select()
    Dim strPath As String
    strPath = "C:\Pictures\" '圖片所在文件夾路徑
    Dim imgExtension As String
    imgExtension = "*.jpg" '圖片擴展名
    Dim imgCount As Integer
    imgCount = 0 '導入圖片數量
    Dim strFile As String
    strFile = Dir(strPath & imgExtension)
    Dim r As Range
    For Each r In ActiveSheet.Range("A1:A10") '以A1:A10範圍內的姓名為圖片名稱
        strFile = Dir(strPath & Left(r.Value, 3) & imgExtension)
        If Len(strFile) = 0 Then
            MsgBox "未找到名為" & Left(r.Value, 3) & "的照片。"
            Exit Sub
        End If
        Dim pic As Picture
        Set pic = ActiveSheet.Pictures.Insert(strPath & strFile)
        pic.Top = r.Top
        pic.Left = r.Left + r.Width + 5 '將圖片放在姓名列的右側5個單元格
        pic.Width = 100
        pic.Height = 100
        imgCount = imgCount + 1
        Dim picPath As String
        picPath = strPath & strFile
        Set pic = Nothing
        strFile = Dir
        ActiveSheet.Shapes.Range(Array(pic.Name)).OnAction = "Select_Picture('" & picPath & "')"
    Next r
    MsgBox imgCount & "張圖片已成功導入到Excel中！"
End Sub

Function Select_Picture(picPath)
    Dim pic As Picture
    Set pic = ActiveSheet.Pictures.Insert(picPath)
    pic.Top = ActiveCell.Top
    pic.Left = ActiveCell.Left
    pic.Width = ActiveCell.Width
    pic.Height = ActiveCell.Height
    Set pic = Nothing
End Function