週末愉快~~請教各位導師們~
Excel vba代碼問題,需要怎麼樣修改才能在下次執行代碼時插入圖片是從空白處開始
目前代碼功能設定是在SHEET2 工作表中，從G3儲存格開始放入圖片

圖片和楕圓圖形直接群組，屬性設定成"大小固定，位置隨儲存格而變"
現在一直在反覆測試要在下次執行時自動搜索從空白儲存格(沒有圖片地方)開始插入
一直卡住......老是從G3儲存格插入，請各位導師指點一下~謝謝。

Sub InsertPic333()
    Const xlMoveButNoChange As Integer = 2
    Dim folderPath As String
    Dim FilesInFolder As Variant
    Dim Pic As Variant
    Dim shp As Shape
    Dim picShp As Shape
    Dim groupShp As Shape
    Dim rng As Range
    Dim cellHeight As Single
    Dim i As Long
    
    Application.ScreenUpdating = False
    
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "選擇要插入的圖片檔案"
    .Filters.Clear
    .Filters.Add "圖片檔案", "*.jpg;*.jpeg;*.png;*.bmp", 1
    If .Show = True Then
        ReDim FilesInFolder(1 To .SelectedItems.Count)
        For i = 1 To .SelectedItems.Count
            FilesInFolder(i) = .SelectedItems(i)
        Next i
    Else
        Exit Sub
    End If
End With

    If IsEmpty(FilesInFolder) Then
        MsgBox "No image files found in the selected folder."
        Exit Sub
    End If
    
    i = 3 ' 設定初始值為 3
    On Error Resume Next
For Each Pic In FilesInFolder
        
    Set rng = Sheet2.Range("G" & i)
    Set shp = Sheet2.Shapes.AddPicture(Pic, msoFalse, msoTrue, rng.Left, rng.Top, -1, -1)

    shp.Name = "Pic_" & i
    
    ' 計算圖片中心點位置
    Dim picCenterLeft As Single
    Dim picCenterTop As Single
    picCenterLeft = shp.Left + (shp.Width / 2)
    picCenterTop = shp.Top + (shp.Height / 2)
    
    Set picShp = Sheet2.Shapes.AddShape(msoShapeOval, picCenterLeft - shp.Width / 4, picCenterTop - shp.Height / 4, shp.Width / 2, shp.Height / 2)
    picShp.Line.ForeColor.RGB = RGB(255, 0, 0)
    picShp.Fill.Transparency = 1
    picShp.Name = "Pic_" & i & "_Oval"
    
    Set groupShp = Sheet2.Shapes.Range(Array(shp.Name, picShp.Name)).Group
    groupShp.Name = "Pic_" & i & "_Group"
    
    With groupShp
        .TopLeftCell = rng
        .Height = rng.Height
        .Width = rng.Width
        .Placement = xlMoveButNoChange
    End With
    
    i = i + 1 '向下移動到下一行的單元格
    
Next Pic
    Application.ScreenUpdating = True
End Sub

Function GetFiles(ByVal folderPath As String, ByVal filePattern As String) As Variant
Dim arrFiles() As Variant
Dim i As Long
Dim file As Variant

i = 0
file = Dir(folderPath & "\" & filePattern)
Do Until file = ""
    ReDim Preserve arrFiles(i)
    arrFiles(i) = folderPath & "\" & file
    i = i + 1
    file = Dir()
Loop

GetFiles = arrFiles
End Function