Activesheet.Shapes.AddPicture

Question

请容忍我，我是个新手，我正在尝试在一个excel文件中嵌入一个图像，但是当我运行这段代码的时候，它总是在我身上乱丢东西。我一张一张地找了一遍又一遍都找不到答案。

'Import Image
Sub GetPic()
Dim fNameAndPath As String
Dim img As Object

ChDir ActiveWorkbook.Path
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")

    'set img line is highlighted hovering displays a message. img = nothing

    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, Pathlinktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
    With img

       'Move and Resize Image
        img.Select
       Selection.ShapeRange.LockAspectRatio = msoFalse
       Selection.Left = ActiveSheet.Range("H10").Left
       Selection.Top = ActiveSheet.Range("H10").Top
       Selection.Width = ActiveSheet.Range("H10:O10").Width
       Selection.Height = ActiveSheet.Range("H10:O24").Height

    End With
End Sub

Answer 1

这段代码已经过测试，可以正常工作：

'Import Image
Sub GetPic()
Dim fNameAndPath As String
Dim img As Object


fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
    With img
       'Move and Resize Image
       .ShapeRange.LockAspectRatio = msoFalse
       .Left = ActiveSheet.Range("H10").Left
       .Top = ActiveSheet.Range("H10").Top
       .Width = ActiveSheet.Range("H10:O10").Width
       .Height = ActiveSheet.Range("H10:O24").Height
    End With
End Sub

Answer 2

尝尝这个

Sub GetPic()
 Dim fNameAndPath As String
 Dim img As Excel.Shape

 ChDir ActiveWorkbook.Path
 fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")

 Set img = ActiveSheet.Shapes.AddPicture( _
  fNameAndPath, msoFalse, msoCTrue, ActiveSheet.Range("H10").Left, _
  ActiveSheet.Range("H10").Top, ActiveSheet.Range("H10:O10").Width, _
  ActiveSheet.Range("H10:O24").Height)
  img.LockAspectRatio = msoFalse

  'Just for fun:
   img.IncrementRotation 45
End Sub