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

Answer 2

尝试一下。

Sub AddImageTo()

Dim TheFile() As String
Dim Cell As Range
Dim rngPic() As Range
Dim i As Integer, k As Integer, n As Integer, j As Integer

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"
         .Show
            For i = 1 To .SelectedItems.Count
                k = k + 1
                ReDim Preserve TheFile(1 To k)
                    TheFile(k) = .SelectedItems(i)
                Next i
End With
'No file selected
If k = 0 Then
    MsgBox ("No image selected")
Exit Sub
End If

Set objImage = CreateObject("WIA.ImageFile")
    objImage.LoadFile TheFile(1)
For Each Cell In Selection
    n = n + 1
    ReDim Preserve rngPic(1 To n)
    Set rngPic(n) = Cell
Next Cell
For j = 1 To UBound(TheFile)
    If j > n Then Exit Sub
        With rngPic(j)
            .ClearComments
            .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 j
End Sub

使用VBA将多个图像作为注释插入多个单元格中，使下标超出范围错误（9）

2 个答案: