图像嵌入到Excel电子表格 - VBA

Question

我需要的图像嵌入到Excel中通过VBA，电子表格等，每当我重新安置我的excel文件，图像仍然会出现。我怎样才能做到这一点？

Answer 1

此代码将插入当前工作表，并将其放置在一个图像，以单元格E10：

Set oPic = Application.ActiveSheet.Shapes.AddPicture("d:\temp\mypic.jpg", False, True, 1, 1, 1, 1) 
oPic.ScaleHeight 1, True 
oPic.ScaleWidth 1, True 

oPic.Top = Range("E10").Top 
oPic.Left = Range("E10").Left 

Answer 2

你尝试使用宏录制？

这是它产生的对我来说：使用谷歌的搜索字词

Sub Macro1() 

    ActiveSheet.Pictures.Insert ("C:\mypicture.jpg") 

End Sub 

此外吨的信息：“插入图片使用VBA Excel中”。以下代码取自ExcelTip全部感谢原作者Erlandsen Data Consulting。

有了下面你可以在一个工作表中的任何范围内插入图片和图片本身仍然在原来的位置，他们将只要保持宏。

图片可以居中水平和/或垂直。

Sub TestInsertPicture() 
    InsertPicture "C:\FolderName\PictureFileName.gif", _ 
     Range("D10"), True, True 
End Sub 

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _ 
    CenterH As Boolean, CenterV As Boolean) 
    ' inserts a picture at the top left position of TargetCell 
    ' the picture can be centered horizontally and/or vertically 
    Dim p As Object, t As Double, l As Double, w As Double, h As Double 
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
    If Dir(PictureFileName) = "" Then Exit Sub 
    ' import picture 
    Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
    ' determine positions 
    With TargetCell 
     t = .Top 
     l = .Left 
     If CenterH Then 
      w = .Offset(0, 1).Left - .Left 
      l = l + w/2 - p.Width/2 
      If l < 1 Then l = 1 
     End If 
     If CenterV Then 
      h = .Offset(1, 0).Top - .Top 
      t = t + h/2 - p.Height/2 
      If t < 1 Then t = 1 
     End If 
    End With 
    ' position picture 
    With p 
     .Top = t 
     .Left = l 
    End With 
    Set p = Nothing 
End Sub 

使用下面的宏，您可以插入图片并将它们放入工作表中的任何范围。

Sub TestInsertPictureInRange() 
    InsertPictureInRange "C:\FolderName\PictureFileName.gif", _ 
     Range("B5:D10") 
End Sub 

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) 
    ' inserts a picture and resizes it to fit the TargetCells range 
    Dim p As Object, t As Double, l As Double, w As Double, h As Double 
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
    If Dir(PictureFileName) = "" Then Exit Sub 
    ' import picture 
    Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
    ' determine positions 
    With TargetCells 
     t = .Top 
     l = .Left 
     w = .Offset(0, .Columns.Count).Left - .Left 
     h = .Offset(.Rows.Count, 0).Top - .Top 
    End With 
    ' position picture 
    With p 
     .Top = t 
     .Left = l 
     .Width = w 
     .Height = h 
    End With 
    Set p = Nothing 
End Sub