Forum Discussion
VBA help for a Macro (inserting picture from file)
Hi,
I am new to VBA and macros and I was hoping that someone could help me writing the VBA to insert a photo from your personal files. I created the button, but I just need to write the VBA to pull up the users files so they can select the photo. From there I want the photo to be placed in the cell (you'll see on the sheet which cell I am referring to). The cells are already merged together. I want the photo to fit in the cell that is already merged.
For some reason this forum won't let me upload a macro, so I am going to insert the excel file. You'll see where I want the photo's on the "FLYER V1" tab.
Thanks! Let me know if you have any questions
- Matt MickleBronze Contributor
Brady-
Please follow the below steps to accomplish your task:
1. Open the Visual Basic Editor (VBE) using Alt + F11
2. Insert > Module
3. Paste the below code in the new code module
Sub GetPic() Dim fNameAndPath As Variant Dim img As Picture fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported") If fNameAndPath = False Then Exit Sub Set img = ActiveSheet.Pictures.Insert(fNameAndPath) With img 'Resize Picture to fit in the range.... .Left = ActiveSheet.Range("D9").Left .Top = ActiveSheet.Range("D9").Top .Width = ActiveSheet.Range("D9:H9").Width .Height = ActiveSheet.Range("D9:D28").Height .Placement = 1 .PrintObject = True End With End Sub
4. Go back to the worksheet
5. Right Click on the button > Assign Macro
6. Select the GetPic Macro
After following these steps you should get the expected result.
- dklein_14Copper Contributor
That code worked perfectly, my question is I have 6 other locations to place the same image how can I do so for the other 6?
- Matt MickleBronze Contributor
Hey dklein_14-
Can you please tell me a few things for clarification?
What are the 6 different ranges? If the ranges are on different worksheets can you further clarify with worksheet names?
-Matt
- TsengeeCopper Contributor
Hello Matt Mickle
Can you help me on this Macro Please. I want to insert Picture but this Macro is not working in my MacBook maybe this Macro for PC computer.
- tghendrickCopper Contributor
Hey Matt Mickle
I'm having problems with this Macro for inserting photos. I copied it from a PC parallel to use on my Mac but it's keeps telling me the file doesn't exist. Can you help?
I uploaded a test file, the other one is a much larger file.
Sub InsertAnyPicture() Dim image As String Columns("A:B").Select Selection.Insert Shift:=xlToRight Range("A2").Select ActiveCell.FormulaR1C1 = _ "=CONCATENATE(""E:\Users\Tamara\Desktop\MIASTOCK INVENTORY\images\"",RC[2],"".jpeg"")" Application.Goto Reference:="OFFSET(R2C1,0,0,COUNTA(C3)-1,1)" Selection.FillDown Application.Goto Reference:="OFFSET(R2C1,0,0,COUNTA(C3)-1,1)" Set InputedRange = Range(Selection.Address) For Each C In InputedRange C.RowHeight = 45.5 image = C.Value If File_Exists(image) = True Then Call AddPic(image, C.Offset(0, 1)) Else C.Offset(0, 1).Value = "NO FILE" End If If C.Value = "" Then Exit Sub End If Next C Range("a1").Select Columns(1).EntireColumn.Delete End Sub Sub AddPic(sFile As String, r As Range) With r.Areas(1) ActiveSheet.Shapes.AddPicture FileName:=sFile, _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Top:=.Top, Left:=.Left, _ Height:=45, Width:=45 End With End Sub Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean 'Returns True if the passed sPathName exist 'Otherwise returns False On Error Resume Next If sPathName <> "" Then If IsMissing(Directory) Or Directory = False Then File_Exists = (Dir$(sPathName) <> "") Else File_Exists = (Dir$(sPathName, vbDirectory) <> "") End If End If End Function
- Matt MickleBronze Contributor
Brady-
Just wanted to follow up and see if you were able to resolve your issue. If you're still having trouble don't hesitate to reach back out and ask additional inquiries. Always happy to help!
- sumera1913Copper Contributor
After using the VBA how to break the link from images. As the file is shared through email and images will goes off
- Gstg72Copper Contributor
I'm having the same issue as far as the link being inserted, but not the picture. So It can't be shared or sent via email to customers. Any thoughts on how to change this from a link insert to a picture insert?
Thanks so much for your time
- NikolinoDEGold Contributor
To be honest, I asked where it is best to include such a VBA code.
Most of them say with Outlook, not Excel.
So I searched the internet and found this information.
Folder selection when sending With this VBA code, any e-mail folder can be selected as storage when sending an e-mail. To use this example, please note the important information and the workshop Using VBA in Outlook.
Please copy the 1st part of the code into a new module (insert -> module in the VBA editor):
Option Explicit Public Function SentFolder (ByRef Item As Object) As Boolean '================================================== ===================== '' Displays the Outlook® selection folder when sending an email 'If required, e-mail to a folder other than "Sent Items" 'to discard. '(c) http://www.outlook-stuff.com '2008-11-19 version 1.0.1 '================================================= ===================== Dim obj Folder As Object '------------------------------------------------- -------------------- 'Although the SaveSentMessageFolder- 'property should also be possible for meeting requests 'there is a mistake with these. Hence, prior to using this 'Function asks whether the item is an email. '------------------------------------------------- -------------------- If Not Item.Class = olMail Then Exit Function '------------------------------------------------- -------------------- 'The loop is run through until a valid folder is selected 'or the selection is canceled. '------------------------------------------------- -------------------- do '------------------------------------------------- ---------------- 'Show folder selection '------------------------------------------------- ---------------- Set objFolder = Nothing Set objFolder = Outlook.Session.PickFolder '------------------------------------------------- ---------------- 'Has the selection been canceled? '------------------------------------------------- ---------------- If objFolder Is Nothing Then SentFolder = True Exit function End If '------------------------------------------------- ---------------- 'Wrong folder type selected? '------------------------------------------------- ---------------- If InStr (objFolder.DefaultMessageClass, "IPM.Note") = 0 Then Set objFolder = Nothing If MsgBox ("Please select a folder for emails." _ , vbCritical + vbOKCancel, "Select shelf") = vbCancel Then SentFolder = True Exit function End If End If '------------------------------------------------- ---------------- 'The inbox is not suitable as a shelf '------------------------------------------------- ---------------- If Not objFolder Is Nothing Then If objFolder = Outlook.Session.GetDefaultFolder (olFolderInbox) Then If MsgBox ("Are you sure you want to put the sent email in the inbox?" _ , vbExclamation + vbYesNo + vbDefaultButton2, "Select storage") = vbNo Then Set objFolder = Nothing End If End If End If Loop While objFolder Is Nothing '------------------------------------------------- -------------------- 'Define the storage location of the email '------------------------------------------------- -------------------- Set Item.SaveSentMessageFolder = objFolder '------------------------------------------------- -------------------- 'Delete reference to folder '------------------------------------------------- -------------------- Set objFolder = Nothing End function 'source: https://www.outlook-stuff.com/tipps-tricks/programmierung/287-ordnerauswahl-'beim-senden.html
The call is made from the Application_ItemSend event in the module ThisOutlookSession. Please copy the 2nd part of the code here:
Übersetzungstypen Textübersetzung Ausgangstext 908 / 5000 Übersetzungsergebnisse Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean) '================================================= ===================== 'This procedure is recorded immediately before an email is sent. ' call. If "Cancel" is true, the sending of the e-mail is canceled. '(c) http://www.outlook-stuff.com '2008-11-19 version 1.0.1 '================================================== ===================== '------------------------------------------------- -------------------- 'Show folder selection for storing the sent mail '------------------------------------------------- -------------------- Cancel = SentFolder (Item) '------------------------------------------------- -------------------- 'Delete reference to email '------------------------------------------------- -------------------- Set Item = Nothing End Sub
At the beginning I would not have thought that it could be so difficult.
In retrospect, however, I understand watum it's so hard.
It's not about Excel, it's about Outlook.
It doesn't really matter whether I send an Excel file or another file as an e-mail.
-------------------
Supplement:
(Step by step)
Outlook, start the VBA editor successfully.
I add Code 1 via "Insert / Module". In the drop-down menus in the pop-up window, (“Selection”), (“Declarations”) remains.
The left is now under Project1 (VbaProject.OTM)
- Microsoft Outlook objects
- ThisOutlookSession
- modules
- Module 1
If I now double-click “ThisOutlookSession”, a window opens again, the drop-down menu says “Application” on the left and “ItemSend” on the right.
I copy code 2 into the free field.
I save everything (without renaming anything), go back to Outlook, restart Outlook.
When I write an email now, I get various error messages:
First runtime error for "AddinTools Classic Menu for Outlook".
Then the VBA editor opens again, module 1 is marked on the left and the pop-up window reads:
"Error during compilation, invalid outside of a procedure, module 1 marked".
If I click away, I quit the debugger.
Don't forget to reactivate the macros.
----------------------------------------------
I hope that you will get a little further with it.
Thank you for your understanding and patience
Nikolino
I know I don't know anything (Socrates)
- NikolinoDEGold Contributor
Look the File please
If it helped, I am very happy ... please mark this as the correct answer so that others are informed. If not, please give a short feedback, maybe the other helpers could help more than me.
Nikolino
I know I don't know anything (Socrates)
- NikolinoDEGold Contributor
Here is a very simple solution that also works ... has been tested.
Open the file and enable all macros and content, then click the "Insert Photo" button.
An explorer appears where you can search for and select your picture and confirm with OK.
Then a window will appear asking you to click on the start cell where the photo should be inserted. Click on the start cell and the picture is where you want it to be.
I would be happy to know if I could help.
Nikolino
I know I don't know anything (Socrates)
* Kindly Mark and Vote this reply if it helps please, as it will be beneficial to more Community members reading here.
- kadirgulerCopper Contributor
Hi,
First of all I recommend that the pictures are in the same folder as the workbook.
Next you need to enter some codes in the Worksheet_Change procedure of the worksheet. For example, we can enter the following codes to add the image that with the same name as the value of cell in column A to the cell in column :Private Sub Worksheet_Change(ByVal Target As Range) Dim pic As Picture If Intersect(Target, [A:A]) Is Nothing Then Exit Sub On Error GoTo son For Each pic In ActiveSheet.Pictures If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 3).Address)) Is Nothing Then pic.Delete End If Next pic ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select Selection.Top = Target.Offset(0, 2).Top Selection.Left = Target.Offset(0, 3).Left Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = Target.Offset(0, 2).Height Selection.ShapeRange.Width = Target.Offset(0, 3).Width son: End Sub
The picture is sized according to the cell that it is added to.
- DarkmanCopper ContributorDear Sirs I have been trying without success to create a VBA or macro to automatically take a folder address of pictures and then match it ascending down from the pic name i.e hf-001.jpg by using the cell ref within the other cell say i.e hf-001 descending down to last populated cell is this possible as all I have managed to do is get 1 picture to populate 1 cell sorry if a big ask as a beginner in all this but trying my best to do as much on my own for a small charity.
- Full_MoonCopper ContributorHii,
I want a code of "Insert multiple Images on Multiple worksheets automatically" give path and run.
I don't want to choose path.
Please share