-1

i have excel file with multiple sheet and im looking for a way to import multiple image to an excel of which each image is placed to each sheet in the same workbook.

i tried to use the one from here : https://answers.microsoft.com/en-us/msoffice/forum/all/macro-to-insert-multiple-images-to-multiple-sheet/ea150439-ef4e-4ecd-8035-56578abb088a

but its not working as i wanted, i noticed that it seems like it follow the name of the sheet.

Some details:

  1. My sheet naming is Sheet1, Sheet1 (2). Sheet1 (3), etc..
  2. i'd prefer if the image is placed as we would copy and paste and not dissapear if the source file is deleted.
  3. The image will be placed at say B20, and i would like to strecth it a bit from right like 2px

Apreciate if anyone could help.. Thank you for your help..

NewbieCabbage
  • 5
  • 2
  • Welome to your first question (noticed you've been lurking for a few years). Could you have a read of [ASK] and [MCVE] please? "_Not working as i wanted_" doesn't give much of a clue as to what's wrong - if you remove the `On Error Resume Next` line from the code in the link it will give you a better idea of what's wrong (that tells it to skip to the next line if there's an error - so you won't get an error message, but are likely to get odd results as it executes the lines it can and ignores the ones it can't). – Darren Bartrup-Cook Aug 03 '21 at 13:03
  • i'm sorry, from my title and my 1st para i think i highlighted what i want and the example just doesnt do that.. im sorry if my english is bad. even if i remove On Error Resume Next the code has no error, just it doesnt do what i want. below answer already answered my question i just need a little tweak a bit.. all and all it works as what i want.. thanks. – NewbieCabbage Aug 03 '21 at 13:30

1 Answers1

1

There's a lot of things that are done in a weird manner in that example.
From the use of .select to the counter inside the for loop.
I tried cleaning it up a little and making it more general.
Should work for most of your requirements.
No idea if this links the original file or not, It works in whatever manner it originally did.

Option Explicit
Sub Insert_Picture()
Dim myPicture As Variant
Dim lLoop As Long

myPicture = Application.GetOpenFilename _
    ("Pictures (*.gif; *.jpg; *.bmp; *.tif; *.png),*.gif; *.jpg; *.bmp; *.tif *.png", , "SELECT FILE(S) TO IMPORT", MultiSelect:=True)
If VarType(myPicture) = vbBoolean Then
    MsgBox "NO FILES SELECTED"
    Exit Sub
End If

If IsArray(myPicture) Then      
    For lLoop = LBound(myPicture) To UBound(myPicture)
        With Sheets(lLoop).Pictures.Insert(myPicture(lLoop))
            .Left = Sheets(lLoop).Cells(20, 2).Left
            .Top = Sheets(lLoop).Cells(20, 2).Top
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = .Width + 2
        End With
    Next lLoop
End If

MsgBox "Copy Completed"
End Sub

Seems like if we use the Shapes.AddPicture method instead we can unlink the image:

With Sheets(lLoop).Shapes.AddPicture( _
    Filename:=myPicture(lLoop), _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=Sheets(lLoop).Cells(20, 2).Left, _
    Top:=Sheets(lLoop).Cells(20, 2).Top, _
    Width:=-1, _
    Height:=-1)
    .LockAspectRatio = msoFalse
    .ScaleWidth 1.203, msoTrue
End With
Christofer Weber
  • 1,464
  • 1
  • 9
  • 18
  • boss, this is so perfect.. it work like i wanted. thank you so much.. in 3rd request is something like this.. .ShapeRange.ScaleWidth 1.203, msoFalse, msoScaleFromTopLeft i added and it work, but the image also increase in height.. could you help me with this? oh, 1 thing, if i move the image file, the one in excel gone too. is there anyways we can make it save it permanently or what was it called? embeded image? – NewbieCabbage Aug 03 '21 at 13:18
  • I might have edited a few times before you tested it and commented, sorry about that. I added disabling of aspect ratio in an edit. That worked for width at least. `.ShapeRange.LockAspectRatio = msoFalse` – Christofer Weber Aug 03 '21 at 13:21
  • yes2, like this.. i also found it. thank you.. any idea on how to permanenly embed the image? – NewbieCabbage Aug 03 '21 at 13:26
  • Found something that might work over [here](https://stackoverflow.com/questions/12936646/how-to-insert-a-picture-into-excel-at-a-specified-cell-position-with-vba) but insert doesn't support these parameters. `AddPicture` however does. – Christofer Weber Aug 03 '21 at 13:51
  • Thank you boss. i also do searching and found https://stackoverflow.com/questions/17110425/how-to-insert-an-embedded-picture but i dont know how to apply in this case.. with your solution it is working well now.. thank you so much.. i really appreciate your help.. have a good day sir.. – NewbieCabbage Aug 03 '21 at 13:55