vba - 使用 VBA 将多个图像作为注释插入到多个单元格中，给出下标超出范围错误 (9)

Question

尝试将多个图像插入多个单元格中的注释时，下标超出范围(错误 9)。 VBA代码的想法是让我能够在工作簿中选择多个单元格，然后选择多个图像，它会按顺序将图像添加为每个单元格的注释。

为了做到这一点，我首先尝试使用 For 循环遍历文件对话框窗口中的选定图像，并将它们添加到 TheFile 数组中。然后我尝试使用另一个 For 循环将 j 的数组位置中的图像添加到当前单元格中，然后移动到下一个单元格并执行相同操作。

知道是什么导致下标超出范围错误吗？我的代码如下:

Sub AddImageTo()

Dim TheFile() As String

With Application.FileDialog(msoFileDialogFilePicker)
         .AllowMultiSelect = True          'Only one file
         .InitialFileName = CurDir         'directory to open the window
         .Filters.Clear                    'Cancel the filter
         .Filters.Add Description:="Images", Extensions:="*.*", Position:=1
         .Title = "Choose image"

         If .Show = -1 Then
            For i = 1 To .SelectedItems.Count
            TheFile(i) = .SelectedItems(i)
            Next i
         Else: TheFile(1) = 0
         End If
End With
'No file selected
If TheFile(1) = 0 Then
MsgBox ("No image selected")
Exit Sub
End If

Set objImage = CreateObject("WIA.ImageFile")
    objImage.LoadFile TheFile

For j = 1 To UBound(TheFile)
For Each cell In Selection
    With ActiveCell
        .AddComment
        With .Comment
            With .Shape
                .Fill.UserPicture TheFile(j)
                .Height = objImage.Height * 0.45
                .Width = objImage.Width * 0.45
            End With
        End With
    End With
Next cell
Next j
End Sub

Answer 1

问题是如果你 Dim TheFile() As String您的数组没有定义的维度，因此您无法访问数组中的任何项目，如 TheFile(1) = 0 .

这是一个关于如何使用 FileDialog 进行多选的示例

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
    .InitialFileName = CurDir             
    .InitialView = msoFileDialogViewList  
    .AllowMultiSelect = True
    .Filters.Clear 
    .Filters.Add Description:="Images", Extensions:="*.*", Position:=1
    .Title = "Choose image"
End With

Dim FileChosen As Integer 
FileChosen = fd.Show 'show dialog

If FileChosen = -1 Then

    Dim AddImagesRange As Range
    Set AddImagesRange = Selection

    'check if cells count matches files count
    If AddImagesRange.Cells.Count <> fd.SelectedItems.Count Then
        MsgBox "Count of seletced cells does not match count of images"
        Exit Sub
    End If

    Dim i As Long:  i = 1
    Dim objImage As Object

    Dim Cell As Range
    For Each Cell In AddImagesRange
        Set objImage = CreateObject("WIA.ImageFile")
        objImage.LoadFile fd.SelectedItems(i)

        Cell.AddComment
        With Cell.Comment.Shape 'avoid cascaded with statements
            .Fill.UserPicture fd.SelectedItems(i)
            .Height = objImage.Height * 0.45
            .Width = objImage.Width * 0.45
        End With

        i = i + 1
        Set objImage = Nothing
    Next Cell

Else
    MsgBox ("No image selected")
    Exit Sub
End If