Insert image without link

H

Hatye

Board Regular
Joined
Jan 11, 2010
Messages
143
Hi,

I use the following code which works as wanted:

Code: 
Private Sub CommandButton1_Click()


Dim myPicture
Dim MyObj As Object


Application.ScreenUpdating = False


Sheets("Kumkort").Unprotect


myPicture = Application.GetOpenFilename _
("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
, "Velg bilde som skal settes inn")


If VarType(myPicture) = vbBoolean Then Exit Sub


    On Error Resume Next
    Sheets("Kumkort").Shapes("Kumkort_bilde1").Delete
    On Error GoTo 0
    
    On Error Resume Next
    Sheets("Kumkort").Shapes("Kumkort_bilde2").Delete
    On Error GoTo 0
    
    On Error Resume Next
    Sheets("Kumkort").Shapes("Kumkort_bilde3").Delete
    On Error GoTo 0
    
    On Error Resume Next
    Sheets("Kumkort").Shapes("Kumkort_bilde4").Delete
    On Error GoTo 0


Range("B23").Select


Set MyObj = Sheets("Kumkort").Pictures.Insert(myPicture)


    With MyObj
        With .ShapeRange
        .LockAspectRatio = msoTrue
        .Height = 328
        '.Width = 434
        .Top = Range("B23").Top
        .Left = Range("B23").Left
        .Name = "Kumkort_bilde1"
        End With
    .Placement = xlMoveAndSize
    End With
    
Set MyObj = Nothing


    ActiveSheet.Shapes.Range(Array("Kumkort_bilde1")).Select
    Selection.ShapeRange.IncrementTop 5
    Selection.ShapeRange.IncrementLeft 5


Sheets("Kumkort").Protect


Application.ScreenUpdating = True


Kumkort_BildeForm.Hide


End Sub

The only thing is that I would like the code to insert the image without link to the image file. That is; the Excel workbook should be possible to send to different users, and the image file path could be changed..

I have found something like
Code: 
ActiveSheet.Shapes.AddPicture

But it doesn't work when I replace the existing code with this..
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
yky said:
You want to use Sheets.Shapes.AddPicture instead of Sheets.Pictures.Insert.
Click to expand...

Hi,
I have tried, but cannot make it work. I have tried replacing this line:
Code: 
Set MyObj = Sheets("Kumkort").Pictures.Insert(myPicture)

With this one:
Code: 
 Set MyObj = Sheets("Kumkort").Shapes.AddPicture(myPicture)
Everything else unchanged, without any luck.

The error message says:
"Wrong number of arguments or invalid property assignment".
 
Upvote 0
Remove those two lines in red and see what happens.

Code: 
    With MyObj
[COLOR=#ff0000]        With .ShapeRange[/COLOR]
        .LockAspectRatio = msoTrue
        .Height = 328
        '.Width = 434
        .Top = Range("B23").Top
        .Left = Range("B23").Left
        .Name = "Kumkort_bilde1"
[COLOR=#ff0000]        End With[/COLOR]
    .Placement = xlMoveAndSize
    End With
 
Last edited:
Upvote 0
Nope, same error message. It breaks at this line:

Code: 
Set MyObj = Sheets("Kumkort").Shapes.AddPicture(myPicture)
 
Upvote 0
Try this:
Code: 
Private Sub CommandButton1_Click()

    Dim myPicture
    Dim MyObj                 As Shape
    Dim ws                    As Worksheet

    Application.ScreenUpdating = False

    Set ws = Sheets("Kumkort")
    ws.Unprotect


    myPicture = Application.GetOpenFilename _
                ("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
              , "Velg bilde som skal settes inn")


    If VarType(myPicture) = vbBoolean Then Exit Sub


    On Error Resume Next
    ws.Shapes("Kumkort_bilde1").Delete
    ws.Shapes("Kumkort_bilde2").Delete
    ws.Shapes("Kumkort_bilde3").Delete
    ws.Shapes("Kumkort_bilde4").Delete
    On Error GoTo 0


    Set MyObj = ws.Shapes.AddPicture(Filename:=myPicture, linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                                     Left:=Range("B23").Left + 5, Top:=Range("B23").Top + 5, Width:=-1, Height:=-1)


    With MyObj
        .LockAspectRatio = msoTrue
        .Height = 328
        '.Width = 434
        .Name = "Kumkort_bilde1"
        .Placement = xlMoveAndSize
    End With

    Set MyObj = Nothing

    ws.Protect

    Application.ScreenUpdating = True


    Kumkort_BildeForm.Hide


End Sub
 
Upvote 0
Try this then:

Code: 
Set MyObj = Sheets("Kumkort").Pictures.Insert(Filename:=myPicture,linkToFile:=False, SaveWithDocument:=True,Left:=Range("B23").Left,Top:=Range("B23").Top,Width=434, Height=328)
 
Last edited:
Upvote 0
Hi again,

I used RoryA's code as a base, and this works almost exactly how I want. But, I have adjusted this code to be able to insert 4 images, but they are not inserted in cells S23, B35 and S35 as stated in the code. The only image that are correctly inserted is the first image (B23).

Is there any obvious reason for that?

Code: 
Private Sub CommandButton5_Click()


Dim myPicture
Dim myPicture2
Dim myPicture3
Dim myPicture4
Dim MyObj As Object
Dim MyObj2 As Object
Dim MyObj3 As Object
Dim MyObj4 As Object
Dim ws As Worksheet


Application.ScreenUpdating = False


Set ws = Sheets("Kumkort")
ws.Unprotect


myPicture = Application.GetOpenFilename _
            ("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
            , "Velg bilde som skal settes inn")
            
myPicture2 = Application.GetOpenFilename _
            ("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
            , "Velg bilde som skal settes inn")


            
myPicture3 = Application.GetOpenFilename _
            ("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
            , "Velg bilde som skal settes inn")


            
myPicture4 = Application.GetOpenFilename _
            ("Bilder (*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif),*.gif; *.jpg; *.jpeg; *.png; *.bmp; *.tif", _
            , "Velg bilde som skal settes inn")


If VarType(myPicture) = vbBoolean Then Exit Sub
If VarType(myPicture2) = vbBoolean Then Exit Sub
If VarType(myPicture3) = vbBoolean Then Exit Sub
If VarType(myPicture3) = vbBoolean Then Exit Sub


On Error Resume Next
ws.Shapes("Kumkort_bilde1").Delete
ws.Shapes("Kumkort_bilde2").Delete
ws.Shapes("Kumkort_bilde3").Delete
ws.Shapes("Kumkort_bilde4").Delete
On Error GoTo 0


Set MyObj = ws.Shapes.AddPicture(fileName:=myPicture, linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                                 Left:=Range("B23").Left + 2, Top:=Range("B23").Top + 2, Width:=-1, Height:=-1)


With MyObj
    .LockAspectRatio = msoTrue
    .Height = 165
    .Name = "Kumkort_bilde1"
    .Placement = xlMoveAndSize
    .Locked = msoFalse
End With


Set MyObj = Nothing


Set MyObj2 = ws.Shapes.AddPicture(fileName:=myPicture2, linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                                 Left:=Range("S23").Left, Top:=Range("S23").Top + 2, Width:=-1, Height:=-1)


With MyObj2
    .LockAspectRatio = msoTrue
    .Height = 165
    .Name = "Kumkort_bilde2"
    .Placement = xlMoveAndSize
    .Locked = msoFalse
End With


Set MyObj2 = Nothing


Set MyObj3 = ws.Shapes.AddPicture(fileName:=myPicture3, linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                                 Left:=Range("B35").Left + 2, Top:=Range("B35").Top + 2, Width:=-1, Height:=-1)


With MyObj3
    .LockAspectRatio = msoTrue
    .Height = 165
    .Name = "Kumkort_bilde3"
    .Placement = xlMoveAndSize
    .Locked = msoFalse
End With


Set MyObj3 = Nothing


Set MyObj4 = ws.Shapes.AddPicture(fileName:=myPicture4, linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                                 Left:=Range("S35").Left + 1, Top:=Range("S35").Top + 2, Width:=-1, Height:=-1)


With MyObj4
    .LockAspectRatio = msoTrue
    .Height = 165
    .Name = "Kumkort_bilde4"
    .Placement = xlMoveAndSize
    .Locked = msoFalse
End With


Set MyObj4 = Nothing


ws.Protect


Application.ScreenUpdating = True


Kumkort_BildeForm.Hide


End Sub
 
Upvote 0
Which sheet is the button on, and is the page Zoom set to something other than 100%?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Helps fix VBA code when inserting an image to another computer without causing the image to be blank
Replies
1
Views
163
DanteAmor
DanteAmor
O
  • Solved
VBA - floating photo
Replies
3
Views
305
RoryA
RoryA
A
  • Question Question
How to Unlink an Image/Picture in a spreadsheet to its original path
Replies
7
Views
283
Abegail0203
A
M
  • Question Question
Adding Logos to Workbook in Specific Locations
Replies
9
Views
708
michele227
M
S
  • Solved
VBA Code - Remove link to inserted pictures
Replies
5
Views
680
Domenic
D

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top