[Excel] 如何使用 Excel VBA 快速建立圖片 Mapping Table

8 min readOct 2, 2024

在 Excel 中處理大量圖片時，手動插入圖片及建立對應的圖片名稱會相當耗時。但透過 VBA (Visual Basic for Applications) 的批次處理功能，我們可以快速地從資料夾中匯入圖片檔，並自動建立圖片名稱與對應圖片的 Mapping Table。

步驟 1：建立圖片素材資料夾

在開始建立 VBA 巨集之前，要先將所有圖片存放在一個指定的資料夾中。另外，要確保所有圖片的檔名具有辨識性，這樣在建立 Mapping Table 時才能方便參照。

步驟 2：啟用 Excel 的「開發人員」功能

開啟 Excel，點選「檔案」➝「選項」
選擇「自訂功能區」
在右側的選項中，勾選「開發人員」以啟用開發工具

步驟 3：建立 VBA 巨集

回到 Excel，選擇「開發人員」➝「巨集」
輸入巨集名稱 (例如：ImportImagesName)，然後點選「建立」

3. 在開啟的 VBA 編輯器中，輸入以下程式碼：

macOS 使用者

Sub ImportImagesName()
    Dim folderPath As String
    Dim fileName As String
    Dim ws As Worksheet
    Dim imgRow As Integer
    Dim pic As Picture

    ' 設定資料夾路徑
    folderPath = "/YOUR_FILE_PATH/Logo圖檔/"  ' 替換成你的資料夾路徑

    ' 設定要將資料匯入的工作表
    Set ws = ThisWorkbook.Sheets("FB")  ' 替換成你的工作表名稱

    ' 初始化文件名起始列
    imgRow = 2

    ' 寫入欄位名稱
    ws.Cells(1, 1).Value = "隊名"
    ws.Cells(1, 2).Value = "Logo"

    ' 檢查資料夾存取權限
    If GrantAccessToFolder(folderPath) Then
        ' 循環處理資料夾中的所有檔案
        fileName = Dir(folderPath & "*.*")
        Do While fileName <> ""
            If (InStr(1, fileName, ".jpg", vbTextCompare) > 0 Or InStr(1, fileName, ".png", vbTextCompare) > 0) Then
                ' 移除檔案名稱中的副檔名
                fileName = Left(fileName, InStrRev(fileName, ".") - 1)

                ' 將文件名稱寫入「廣告名稱」欄
                ws.Cells(imgRow, 1).Value = fileName

                ' 移動到下一列
                imgRow = imgRow + 1
            End If
            fileName = Dir
        Loop
    Else
        MsgBox "User denied access to the folder."
    End If
End Sub

Function GrantAccessToFolder(folderPath As String) As Boolean
    Dim appleScript As String
    Dim result As Variant

    ' 建立 AppleScript
    appleScript = "set folderPath to """ & folderPath & """" & vbNewLine
    appleScript = appleScript & "try" & vbNewLine
    appleScript = appleScript & "   alias folderPath" & vbNewLine
    appleScript = appleScript & "on error" & vbNewLine
    appleScript = appleScript & "   choose folder with prompt ""Please select the folder.""" & vbNewLine
    appleScript = appleScript & "   set folderPath to result" & vbNewLine
    appleScript = appleScript & "end try" & vbNewLine
    appleScript = appleScript & "return (POSIX path of folderPath)"

    ' 執行 AppleScript
    On Error Resume Next
    result = MacScript(appleScript)
    On Error GoTo 0

    ' 返回資料夾路徑
    If VarType(result) = vbString Then
        ' 檢查資料夾路徑是否為有存取權限的資料夾路徑
        GrantAccessToFolder = (result = folderPath)
    Else
        GrantAccessToFolder = False
    End If
End Function

Windows 使用者

Sub ImportImagesName()  ' 巨集名稱
    Dim folderPath As String
    Dim fileName As String
    Dim ws As Worksheet
    Dim imgRow As Integer
    Dim pic As Picture

    ' 設定資料夾路徑
    folderPath = "YOUR_FILE_PATH\Logo圖檔\"  ' 替換成你的資料夾路徑

    ' 設定要將資料匯入的工作表
    Set ws = ThisWorkbook.Sheets("工作表1")  ' 替換成你的工作表名稱

    ' 初始化文件名起始列
    imgRow = 2

    ' 寫入欄位名稱
    ws.Cells(1, 1).Value = "隊名"
    ws.Cells(1, 2).Value = "Logo"

    ' 循環處理資料夾中的所有檔案
    fileName = Dir(folderPath & "\*.*")
    Do While fileName <> ""
        If (InStr(1, fileName, ".jpg", vbTextCompare) > 0 Or InStr(1, fileName, ".png", vbTextCompare) > 0) Then
            ' 移除檔案名稱中的副檔名
            fileName = Left(fileName, InStrRev(fileName, ".") - 1)

            ' 將文件名稱寫入「隊名」欄
            ws.Cells(imgRow, 1).Value = fileName

            ' 移動到下一列
            imgRow = imgRow + 1
        End If
        fileName = Dir
    Loop
End Sub