使用工作簿的文件名查找具有相同文件名Excel VBA的图像

时间:2013-12-27 10:28:30

标签: excel vba

我正在测试将图像导入到工作表中,该工作表已经证明是成功的,我如何使用工作簿的文件名,我将其存储在一个范围内,然后查找具有相同文件名的图像的预选目录?

我的文件名保存在Range - LkupFileName

Sub InsertImage()
    Dim ws As Worksheet
    Dim ImgPath As String
    Dim W As Double, H As Double
    Dim L As Long, T As Long
    Set ws = ThisWorkbook.Sheets("myworksheet")
    '~~> File Location of saved JPG
    ImgPath = "C:\images.jpg"
    With ws
       W = 100  '<~~ Width
       H = 50   '<~~ Height
       L = .Range("H140").Left   '<~~ Left Position for image
       T = .Range("H140").Top    '<~~ Top Position for image
       'Copy & Paste Image code
       With .Pictures.Insert(ImgPath)
          With .ShapeRange
             .LockAspectRatio = msoTrue
             .Width = W
             .Height = H
          End With
          .Left = L
          .Top = T
          .Placement = 1
       End With
    End With
End Sub

1 个答案:

答案 0 :(得分:3)

试试这个:

Sub InsertImage()
    Dim ws As Worksheet
    Dim ImgPath As String, ImgName As String
    Dim W As Double, H As Double
    Dim L As Long, T As Long
    Set ws = ThisWorkbook.Sheets("myworksheet")
    '~~> File Location of saved JPG
    ImgName = ws.Range("LkupFileName").Value
    ImgPath = "C:\Foo\Bar\" & ImgName & ".jpg" 'Modify accordingly.
    With ws
       W = 100  '<~~ Width
       H = 50   '<~~ Height
       L = .Range("H140").Left   '<~~ Left Position for image
       T = .Range("H140").Top    '<~~ Top Position for image
       'Copy & Paste Image code
       With .Pictures.Insert(ImgPath)
          With .ShapeRange
             .LockAspectRatio = msoTrue
             .Width = W
             .Height = H
          End With
          .Left = L
          .Top = T
          .Placement = 1
       End With
    End With
End Sub

假设有两件事:

  • LkupFileName,我假设这是一个命名范围。
  • 图像将始终位于您指定的目录中。

如果有帮助,请告诉我们。 :)