Question

我将如何修改以下代码，将本地临时文件夹中的链接图片嵌入到实际excel文件中的每个单元格中？

'####### Add pictures to excel structure ################
For i = 2 To lngLastRow

    Dim strFileName As String
    strFileName = strPicFilesPath & objWorksheet.Cells(i, colID).Value & ".jpg"

    If File.Exists(strFileName) Then

        With objWorksheet.Pictures.Insert(strFileName)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                If .Width >= .Height Then
                    .Width = objWorksheet.Cells(i, colImage).Width - 6
                Else
                    .Height = objWorksheet.Cells(i, colImage).Width - 6
                End If
                objWorksheet.Cells(i, colImage).EntireRow.RowHeight = .Height + 6
            End With

            .Left = objWorksheet.Cells(i, colImage).Left + 3 + intIndent * objWorksheet.Cells(i, colID).IndentLevel
            .Top = objWorksheet.Cells(i, colImage).Top + 3
            .Placement = 1                       'Move and Size
            .PrintObject = True
        End With

    End If
Next i
'####### End Add pictures to excel structure ################

Answer 1

我不确定自己在做什么，但是如果要将图像插入文件夹到Excel中，可以尝试下面的代码。

Sub InsertPics()
Dim fPath As String, fName As String
Dim r As Range, rng As Range

Application.ScreenUpdating = False
fPath = "C:\Users\Public\Pictures\Sample Pictures\"
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
i = 1

For Each r In rng
    fName = Dir(fPath)
    Do While fName <> ""
        If fName = r.Value Then
            With ActiveSheet.Pictures.Insert(fPath & fName)
                .ShapeRange.LockAspectRatio = msoTrue
                Set px = .ShapeRange
                If .ShapeRange.Width > Rows(i).Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
                    With Cells(i, 2)
                        px.Top = .Top
                        px.Left = .Left
                        .RowHeight = px.Height
                    End With
            End With
        End If
        fName = Dir
    Loop
    i = i + 1
Next r
Application.ScreenUpdating = True
End Sub

' Note: you need the file extension, such as ',jpg', or whatever you are using, so you can match on that.
Sub Insert()

    Dim strFolder As String
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngCell As Range

    strFolder = "C:\Users\Public\Pictures\Sample Pictures\" 'change the path accordingly
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If

    Set rngCell = Range("E1") 'starting cell

    strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .png files

    Do While Len(strFileName) > 0
        Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Left
            .Top = rngCell.Top
            .Height = rngCell.RowHeight
            .Placement = xlMoveAndSize
        End With
        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop

End Sub

使用Visual Basic在Excel中嵌入链接的图片

1 个答案: