Osadzanie obrazu na arkuszu kalkulacyjnym programu Excel - VBA

Question

Potrzebuję osadzić obraz w arkuszu kalkulacyjnym za pomocą programu Excel VBA, tak aby ilekroć przenosiłem plik excel, obraz nadal będzie wyświetlany. Jak mogę to zrobić?

Answer 1

Ten kod wstawić obraz o aktualnym arkuszu i umieść go na co komórkowy 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

Czy spróbować za pomocą rejestratora makr?

To właśnie on wyprodukowany dla mnie:

Sub Macro1() 

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

End Sub 

także mnóstwo informacji za pomocą Google haseł: "Insert Picture Korzystanie VBA Excel". Poniższy kod pochodzi z ExcelTipwszystkie zasługi oryginalnego autora Erlandsen Data Consulting.

Za pomocą poniższego makra można wstawiać obrazy w dowolnym zakresie arkusza roboczego i pozostaną one tak długo, jak samo zdjęcie pozostanie w pierwotnej lokalizacji.

Obraz może być wyśrodkowany w poziomie i/lub w pionie.

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 

Za pomocą poniższego makra można wstawiać zdjęcia i dopasowywać je do dowolnego zakresu arkusza roboczego.

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