Option Explicit
Function getLastUsedRow(ws As Worksheet) As Long
Dim lastUsedRow As Long: lastUsedRow = 1
On Error Resume Next
lastUsedRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
On Error GoTo 0
getLastUsedRow = lastUsedRow
End Function
Sub 插入產品圖片()
Application.ScreenUpdating = False
Dim i As Long
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
' --------------------------------------------------------------------------------------------
' ----------------------------- VARIABLES FOR ACTIVE SHEET ! ---------------------------------
' --------------------------------------------------------------------------------------------
Dim wsData As Worksheet: Set wsData = ActiveSheet
Dim wsDataStartingRowAnswer As String ' Answer user gave for what is the starting row for the processing !
Dim wsDataStartingRow As Long ' Starting row !
Dim wsDataEndingRow As Long: wsDataEndingRow = getLastUsedRow(wsData) ' Global ending row on the whole sheet !
Dim wsDataProductNumberColumn As String
Dim wsDataProductPictureColumn As String
Dim wsDataProductNumber As String ' Current product number !
Dim wsDataProductPicturePath As String ' Current product picture file system path !
' --------------------------------------------------------------------------------------------
' --------------------------------------------------------------------------------------------
' ----------------------------- VARIABLES FOR FILE SYSTEM ! ----------------------------------
' --------------------------------------------------------------------------------------------
Dim path As String: path = ThisWorkbook.path
Dim picturesFolderName As String: picturesFolderName = "64x64"
'Dim picturesFolderPath As String: picturesFolderPath = path + Application.PathSeparator + picturesFolderName
Dim picturesFolderPath As String: picturesFolderPath = "M:\" + Application.PathSeparator + picturesFolderName
Dim importPicture As Object
' --------------------------------------------------------------------------------------------
' --------------------------------------------------------------------------------------------
' ------- CHECKING IF PICTURES FOLDER EXISTS IN THE SAME DIRECTORY AS CURRENT FILE ! ---------
' --------------------------------------------------------------------------------------------
If Not fso.FolderExists(picturesFolderPath) Then
' MsgBox "Folder named: " + picturesFolderName + " must be in the same directory as this file, please create it and run macro again!"
MsgBox "放置圖片的檔案夾找不到, 請確定有這個資料夾" + picturesFolderName + " "
Exit Sub
End If
' --------------------------------------------------------------------------------------------
' ------------------ ASKING FOR USER INPUT AND CHECKING ITS VALIDITY ! -----------------------
' --------------------------------------------------------------------------------------------
' Ask the user "What is Product number column?" !
' wsDataProductNumberColumn = InputBox("Please enter column letter where product numbers are stored" + vbCrLf + "For example: A", "Product number column")
wsDataProductNumberColumn = InputBox("我將從檔案夾 'M:\64x64' 裡面, 尋找並加入圖片" + vbCrLf + "請問產品編號在哪一欄?" + vbCrLf + "例如: A", "產品欄")
' Check if user inputted anything in product number column !
If wsDataProductNumberColumn = "" Then
' MsgBox "Product number column must be provided, please enter it and run macro again!"
MsgBox "必須輸入產品欄位才能置入圖片啦"
Exit Sub
End If
' Ask the user "What is the starting row?" !
' wsDataStartingRowAnswer = InputBox("Please enter starting row?" + vbCrLf + "For example: 12", "Starting row")
wsDataStartingRowAnswer = InputBox("從哪一列開始置入圖片?" + vbCrLf + "例如: 2", "開始列")
' Check if user provided correct starting run number !
If Not IsNumeric(wsDataStartingRowAnswer) Then
' MsgBox "Starting row must be provided and in correct format, please enter starting row number and run macro again!"
MsgBox "開始列只能輸入數字, 請重新執行巨集"
Exit Sub
End If
' Convert user provided answer to whole number (long number) !
wsDataStartingRow = CLng(wsDataStartingRowAnswer)
' Check if provided answer for product number column is an actual column letter !
wsDataProductNumberColumn = Trim(wsDataProductNumberColumn)
wsDataProductNumberColumn = UCase(wsDataProductNumberColumn)
If Len(wsDataProductNumberColumn) > 1 Then
'MsgBox "Product number column must be a single letter, like 'A' !"
MsgBox "產品編號欄位必須是一個英文字母, 例如: 'A' !"
Exit Sub
End If
If Asc(wsDataProductNumberColumn) < 65 Or Asc(wsDataProductNumberColumn) > 90 Then
' MsgBox "Product number column must be between columns A and Z (A-Z) !"
MsgBox "產品編號欄位必須在 A 到 Z 之間"
Exit Sub
End If
' Ask the user "What is Product picture column?" !
' wsDataProductPictureColumn = InputBox("Please enter column letter where product pictures should be stored" + vbCrLf + "For example: B", "Product picture column")
wsDataProductPictureColumn = InputBox("圖片要放在哪一欄?" + vbCrLf + "例如: B", "圖片欄位")
' Check if user inputted anything in product picture column !
If wsDataProductPictureColumn = "" Then
' MsgBox "Product picture column must be provided, please enter it and run macro again!"
MsgBox "沒有輸入圖片欄位沒法置入圖片, 再見"
Exit Sub
End If
' Check if provided answer for product picture column is an actual column letter !
wsDataProductPictureColumn = Trim(wsDataProductPictureColumn)
wsDataProductPictureColumn = UCase(wsDataProductPictureColumn)
If Len(wsDataProductPictureColumn) > 1 Then
' MsgBox "Product picture column must be a single letter, like 'B' !"
MsgBox "圖片欄位必須是一個英文字母, 例如: 'B' !"
Exit Sub
End If
If Asc(wsDataProductPictureColumn) < 65 Or Asc(wsDataProductPictureColumn) > 90 Then
' MsgBox "Product picture column must be between columns A and Z (A-Z) !"
MsgBox "圖片欄位必須在 A 到 Z 之間"
Exit Sub
End If
If wsDataProductPictureColumn = wsDataProductNumberColumn Then
' MsgBox "Provided product number column and product picture columns are the same, please type different columns and run macro again!"
MsgBox "產品編號的欄位跟放圖片的欄位不能在一個, 請重來, 再見"
Exit Sub
End If
' --------------------------------------------------------------------------------------------
' Check if generated product picture file path exists and if it does, import the picture and center it !
If fso.FileExists(wsDataProductPicturePath) Then
Set importPicture = wsData.Range(wsDataProductPictureColumn + CStr(i)).Parent.Pictures.Insert(wsDataProductPicturePath)
importPicture.Top = wsData.Range(wsDataProductPictureColumn + CStr(i)).Top
importPicture.Left = wsData.Range(wsDataProductPictureColumn + CStr(i)).Left + wsData.Range(wsDataProductPictureColumn + CStr(i)).Width / 2 - importPicture.Width / 2
End If