Adding logo to multiple worksheets

[Craig1]

Hi All,
I am using the code below to add logo's to multiple worksheets. It works great until I send the workbooks to my colleagues. The logo isn't visible for them, I believe it's because it is creating a link to the picture in my own personal drive, I want to embed the logo, could I change the code to embed? When go to my colleagues PC it shows the error "The linked image cannot be displayed" but when I check for links there isn't any, so I think the easiest way will be to modify the code.
Sub AddPicMain()

Dim myPicture As Variant
Dim p As Object
Dim Factor As Single
myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.cgm; *.jpg; *.bmp; *.tif),*.gif; *.cgm; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If myPicture = False Then Exit Sub
For Each Page In Sheets
Page.Activate
Range("A1").Select
Set p = ActiveSheet.Pictures.Insert(myPicture)
'Width and Height are in points (1/72 inch)
p.ShapeRange.LockAspectRatio = msoTrue
Hfactor = 1.5 / (p.Height / 72)
Wfactor = 7 / (p.Width / 72)
If Hfactor < Wfactor Then
Factor = Hfactor
Else
Factor = Wfactor
End If
p.Width = p.Width * Factor
p.Height = p.Height * Factor

Next
End Sub

Thanks in advance Craig.

 

[Yongle]

Instead of ...
ActiveSheet.Pictures.Insert method
use ...
ActiveSheet.Shapes.AddPicture method

https://docs.microsoft.com/en-us/office/vba/api/excel.shapes.addpicture

 

[Craig1]

Thanks for the reply Yongle,
I'm struggling a little to get this method to do the exact same thing.

Craig.

 

[Yongle]

This should get you started
- I have added declarations for ALL variables
- it does help when your code does not work as planned etc

Sub AddPicMain()

    Dim myPicture As Variant, [COLOR=#008080]Page As Variant, Hfactor As Double, Wfactor As Double,[/COLOR][COLOR=#008080]p As Shape[/COLOR]
    Dim Factor As Single
        myPicture = Application.GetOpenFilename _
            ("Pictures (*.gif; *.cgm; *.jpg; *.bmp; *.tif),*.gif; *.cgm; *.jpg; *.bmp; *.tif", _
                , "Select Picture to Import")
    If myPicture = False Then Exit Sub
    For Each Page In Sheets
        Page.Activate
        Range("A1").Select
        Set p = ActiveSheet.Shapes.AddPicture(myPicture, True, True, Range("A1").Left, Range("A1").Top, -1, -1)
        p.LockAspectRatio = msoTrue
        Hfactor = 1.5 / (p.Height / 72)
        Wfactor = 7 / (p.Width / 72)
        If Hfactor < Wfactor Then
            Factor = Hfactor
        Else
           Factor = Wfactor
        End If
        p.Width = p.Width * Factor
        p.Height = p.Height * Factor
    Next
End Sub

 

[Craig1]

Yongle, Thanks for that, it works great.
Does exactly what it says on the tin.

Thanks Again.

Craig.