Home

VBA help for a Macro (inserting picture from file)

%3CLINGO-SUB%20id%3D%22lingo-sub-189094%22%20slang%3D%22en-US%22%3EVBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-189094%22%20slang%3D%22en-US%22%3E%3CP%3EHi%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20new%20to%20VBA%20and%20macros%20and%20I%20was%20hoping%20that%20someone%20could%20help%20me%20writing%20the%20VBA%20to%20insert%20a%20photo%20from%20your%20personal%20files.%20I%20created%20the%20button%2C%20but%20I%20just%20need%20to%20write%20the%20VBA%20to%20pull%20up%20the%20users%20files%20so%20they%20can%20select%20the%20photo.%20From%20there%20I%20want%20the%20photo%20to%20be%20placed%20in%20the%20cell%20(you'll%20see%20on%20the%20sheet%20which%20cell%20I%20am%20referring%20to).%20The%20cells%20are%20already%20merged%20together.%20I%20want%20the%20photo%20to%20fit%20in%20the%20cell%20that%20is%20already%20merged.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EFor%20some%20reason%20this%20forum%20won't%20let%20me%20upload%20a%20macro%2C%20so%20I%20am%20going%20to%20insert%20the%20excel%20file.%20You'll%20see%20where%20I%20want%20the%20photo's%20on%20the%20%22FLYER%20V1%22%20tab.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThanks!%20Let%20me%20know%20if%20you%20have%20any%20questions%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-189094%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%20on%20Mac%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20%26amp%3B%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-379580%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-379580%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F304789%22%20target%3D%22_blank%22%3E%40dklein_14%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3ETry%20the%20below%20code%20example%20which%20loops%20through%20multiple%20locations%20on%20the%20worksheet.%26nbsp%3B%20I%20have%20commented%20the%20code%20for%20better%20understanding.%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EYou%20may%20want%20to%26nbsp%3B%20note%20that%20when%20you%20set%20the%20width%20to%20a%20value%20like%20B3%3AB9%20that%20is%20will%20simple%20make%20the%20image%20the%20length%20of%20the%20B%20column%20or%20similarly%20for%20E9%3AE9%20it%20will%20make%20the%20height%20of%20the%20image%20the%20height%26nbsp%3B%20of%20cell%20E9.%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CPRE%3ESub%20GetPic()%0A%0ADim%20fNameAndPath%20%20%20%20%20As%20Variant%0ADim%20img%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Picture%0ADim%20intLp%20%20%20%20%20%20%20%20%20%20%20%20As%20Integer%0ADim%20arrLeftandTop%20%20%20%20As%20Variant%0ADim%20arrWidth%20%20%20%20%20%20%20%20%20As%20Variant%0ADim%20arrHeight%20%20%20%20%20%20%20%20As%20Variant%0A%0AfNameAndPath%20%3D%20Application.GetOpenFilename(Title%3A%3D%22Select%20Picture%20To%20Be%20Imported%22)%20'Open%20FIle%20Dialog%20to%20allow%20user%20to%20pick%20picture%0AIf%20fNameAndPath%20%3D%20False%20Then%20Exit%20Sub%20'If%20the%20user%20cancels%20then%20exit%20the%20procedure....%0A%0A%20%20%20%20'Define%20the%20different%20range%20arrays%0A%20%20%20%20arrLeftandTop%20%3D%20Array(%22B3%22%2C%20%22Q3%22%2C%20%22Q33%22%2C%20%22Q63%22)%20'Left%20and%20top%20range%20values%0A%20%20%20%20arrWidth%20%3D%20Array(%22B3%3AB9%22%2C%20%22Q4%3AQ8%22%2C%20%22Q33%3AQ38%22%2C%20%22Q63%3AQ68%22)%20'Width%20range%20values%0A%20%20%20%20arrHeight%20%3D%20Array(%22E9%3AE9%22%2C%20%22R4%3AR8%22%2C%20%22R33%3AR38%22%2C%20%22R68%3AR68%22)%20'Height%20range%20values%0A%20%20%20%20%0A%20%20%20%20'Loop%20through%20ranges%20and%20place%20pictures%20one%20at%20a%20time....%0A%20%20%20%20'Note%20arrays%20start%20at%200%0A%20%20%20%20'%20arrLeftandTop(0)%20%3D%20%22B3%22%0A%20%20%20%20'%20arrLeftandTop(1)%20%3D%20%22Q3%22%0A%20%20%20%20'.....etc%0A%20%20%20%20For%20intLp%20%3D%200%20To%203%0A%20%20%20%20%0A%20%20%20%20%20%20%20%20Set%20img%20%3D%20ActiveSheet.Pictures.Insert(fNameAndPath)%20'Set%20image%20for%20insert%0A%20%20%20%20%20%20%20%20With%20img%0A%20%20%20%20%20%20%20%20%20%20%20'Resize%20Picture%20to%20fit%20in%20the%20range....%0A%20%20%20%20%20%20%20%20%20%20%20.Left%20%3D%20ActiveSheet.Range(arrLeftandTop(intLp)).Left%0A%20%20%20%20%20%20%20%20%20%20%20.Top%20%3D%20ActiveSheet.Range(arrLeftandTop(intLp)).Top%0A%20%20%20%20%20%20%20%20%20%20%20.Width%20%3D%20ActiveSheet.Range(arrWidth(intLp)).Width%0A%20%20%20%20%20%20%20%20%20%20%20.Height%20%3D%20ActiveSheet.Range(arrHeight(intLp)).Height%0A%20%20%20%20%20%20%20%20%20%20%20.Placement%20%3D%201%0A%20%20%20%20%20%20%20%20%20%20%20.PrintObject%20%3D%20True%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%0A%20%20%20%20Next%20intLp%20'Go%20to%20next%20array%20value...%20i.e.%20first%20loop%20is%200%2C%20next%20loop%20is%201....etc.%0A%20%20%20%20%0AEnd%20Sub%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-379251%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-379251%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F37127%22%20target%3D%22_blank%22%3E%40Matt%20Mickle%3C%2FA%3E%26nbsp%3Bthe%20locations%20for%20the%206%20other%20images%20are%20as%20follows%3A%3C%2FP%3E%3CPRE%3Eand%20all%20on%20same%20worksheet.%3CBR%20%2F%3E.Left%20%3D%20ActiveSheet.Range(%22q3%22).Left%3CBR%20%2F%3E.Top%20%3D%20ActiveSheet.Range(%22q3%22).Top%3CBR%20%2F%3E.Width%20%3D%20ActiveSheet.Range(%22q4%3Aq8%22).Width%3CBR%20%2F%3E.Height%20%3D%20ActiveSheet.Range(%22r4%3Ar8%22).Height%0A.Placement%20%3D%201%3CBR%20%2F%3E%3CBR%20%2F%3E2%3CBR%20%2F%3E.Left%20%3D%20ActiveSheet.Range(%22q33%22).Left%3CBR%20%2F%3E.Top%20%3D%20ActiveSheet.Range(%22q33%22).Top%3CBR%20%2F%3E.Width%20%3D%20ActiveSheet.Range(%22q33%3Aq38%22).Width%3CBR%20%2F%3E.Height%20%3D%20ActiveSheet.Range(%22r33%3Ar38%22).Height%3CBR%20%2F%3E%3CBR%20%2F%3E3%3CBR%20%2F%3E.Left%20%3D%20ActiveSheet.Range(%22q63%22).Left%3CBR%20%2F%3E.Top%20%3D%20ActiveSheet.Range(%22q63%22).Top%3CBR%20%2F%3E.Width%20%3D%20ActiveSheet.Range(%22q63%3Aq68%22).Width%3CBR%20%2F%3E.Height%20%3D%20ActiveSheet.Range(%22r68%3Ar68%22).Height%3CBR%20%2F%3E%3CBR%20%2F%3EThey%20are%20all%20about%2030%20cell%20spaces%20lower%20and%20I%20have%207%20total.%20%20In%20additional%20I%20have%20a%20sheet%20labeled%20Title%20Page%20and%20there%201%20image%20there%20with%20the%20follow%20location.%3CBR%20%2F%3ETitle%20Page%3CBR%20%2F%3E.Left%20%3D%20ActiveSheet.Range(%22B3%22).Left%3CBR%20%2F%3E.Top%20%3D%20ActiveSheet.Range(%22B3%22).Top%3CBR%20%2F%3E.Width%20%3D%20ActiveSheet.Range(%22B3%3Ab9%22).Width%3CBR%20%2F%3E.Height%20%3D%20ActiveSheet.Range(%22e9%3Ae9%22).Height%3CBR%20%2F%3E%3CBR%20%2F%3EThank%20you%20for%20your%20help!%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-377931%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-377931%22%20slang%3D%22en-US%22%3E%3CP%3E%3CSUB%3EHey%20dklein_14-%3C%2FSUB%3E%3C%2FP%3E%0A%3CP%3E%3CSUB%3ECan%20you%20please%20tell%20me%20a%20few%20things%20for%20clarification%3F%3C%2FSUB%3E%3C%2FP%3E%0A%3CP%3E%3CSUB%3EWhat%20are%20the%206%20different%20ranges%3F%26nbsp%3B%20If%20the%20ranges%20are%20on%20different%20worksheets%20can%20you%20further%20clarify%20with%26nbsp%3B%3C%2FSUB%3E%3CSUB%3Eworksheet%20names%3F%3C%2FSUB%3E%3C%2FP%3E%0A%3CP%3E%3CSUB%3E-Matt%3C%2FSUB%3E%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-377918%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-377918%22%20slang%3D%22en-US%22%3E%3CP%3EThat%20code%20worked%20perfectly%2C%20my%20question%20is%20I%20have%206%20other%20locations%20to%20place%20the%20same%20image%20how%20can%20I%20do%20so%20for%20the%20other%206%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-190313%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-190313%22%20slang%3D%22en-US%22%3E%3CP%3EBrady-%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EJust%20wanted%20to%20follow%20up%20and%20see%20if%20you%20were%20able%20to%20resolve%20your%20issue.%26nbsp%3B%20If%20you're%20still%20having%20trouble%20don't%20hesitate%20to%20reach%20back%20out%20and%20ask%20additional%20inquiries.%26nbsp%3B%20Always%20happy%20to%20help!%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-189134%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-189134%22%20slang%3D%22en-US%22%3E%3CP%3EBrady-%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EPlease%20follow%20the%20below%20steps%20to%20accomplish%20your%20task%3A%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3E1.%20Open%20the%20Visual%20Basic%20Editor%20(VBE)%20using%20Alt%20%2B%20F11%3C%2FP%3E%0A%3CP%3E2.%20Insert%20%26gt%3B%20Module%3C%2FP%3E%0A%3CP%3E3.%20Paste%20the%20below%20code%20in%20the%20new%20code%20module%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CPRE%3ESub%20GetPic()%0ADim%20fNameAndPath%20As%20Variant%0ADim%20img%20As%20Picture%0AfNameAndPath%20%3D%20Application.GetOpenFilename(Title%3A%3D%22Select%20Picture%20To%20Be%20Imported%22)%0AIf%20fNameAndPath%20%3D%20False%20Then%20Exit%20Sub%0A%20%20%20%20Set%20img%20%3D%20ActiveSheet.Pictures.Insert(fNameAndPath)%0A%20%20%20%20With%20img%0A%20%20%20%20%20%20%20'Resize%20Picture%20to%20fit%20in%20the%20range....%0A%20%20%20%20%20%20%20.Left%20%3D%20ActiveSheet.Range(%22D9%22).Left%0A%20%20%20%20%20%20%20.Top%20%3D%20ActiveSheet.Range(%22D9%22).Top%0A%20%20%20%20%20%20%20.Width%20%3D%20ActiveSheet.Range(%22D9%3AH9%22).Width%0A%20%20%20%20%20%20%20.Height%20%3D%20ActiveSheet.Range(%22D9%3AD28%22).Height%0A%20%20%20%20%20%20%20.Placement%20%3D%201%0A%20%20%20%20%20%20%20.PrintObject%20%3D%20True%0A%20%20%20%20End%20With%0AEnd%20Sub%0A%3C%2FPRE%3E%0A%3CP%3E4.%20Go%20back%20to%20the%20worksheet%3C%2FP%3E%0A%3CP%3E5.%20Right%20Click%20on%20the%20button%20%26gt%3B%20Assign%20Macro%3C%2FP%3E%0A%3CP%3E6.%20Select%20the%20GetPic%20Macro%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EAfter%20following%20these%20steps%20you%20should%20get%20the%20expected%20result.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-911451%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-911451%22%20slang%3D%22en-US%22%3E%3CP%3EHello%20Matt%20Mickle%26nbsp%3B%3C%2FP%3E%3CP%3ECan%20you%20help%20me%20on%20this%20Macro%20Please.%20I%20want%20to%20insert%20Picture%20but%20this%20Macro%20is%20not%20working%20in%20my%20MacBook%20maybe%20this%20Macro%20for%20PC%20computer.%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1034487%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20help%20for%20a%20Macro%20(inserting%20picture%20from%20file)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1034487%22%20slang%3D%22en-US%22%3E%3CP%3EHey%26nbsp%3B%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F37127%22%20target%3D%22_blank%22%3E%40Matt%20Mickle%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI'm%20having%20problems%20with%20this%20Macro%20for%20inserting%20photos.%20I%20copied%20it%20from%20a%20PC%20parallel%20to%20use%20on%20my%20Mac%20but%20it's%20keeps%20telling%20me%20the%20file%20doesn't%20exist.%20Can%20you%20help%3F%26nbsp%3B%3C%2FP%3E%3CP%3EI%20uploaded%20a%20test%20file%2C%20the%20other%20one%20is%20a%20much%20larger%20file.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ESub%20InsertAnyPicture()%20Dim%20image%20As%20String%20Columns(%22A%3AB%22).Select%20Selection.Insert%20Shift%3A%3DxlToRight%20Range(%22A2%22).Select%20ActiveCell.FormulaR1C1%20%3D%20_%20%22%3DCONCATENATE(%22%22E%3A%5CUsers%5CTamara%5CDesktop%5CMIASTOCK%20INVENTORY%5Cimages%5C%22%22%2CRC%5B2%5D%2C%22%22.jpeg%22%22)%22%20Application.Goto%20Reference%3A%3D%22OFFSET(R2C1%2C0%2C0%2CCOUNTA(C3)-1%2C1)%22%20Selection.FillDown%20Application.Goto%20Reference%3A%3D%22OFFSET(R2C1%2C0%2C0%2CCOUNTA(C3)-1%2C1)%22%20Set%20InputedRange%20%3D%20Range(Selection.Address)%20For%20Each%20C%20In%20InputedRange%20C.RowHeight%20%3D%2045.5%20image%20%3D%20C.Value%20If%20File_Exists(image)%20%3D%20True%20Then%20Call%20AddPic(image%2C%20C.Offset(0%2C%201))%20Else%20C.Offset(0%2C%201).Value%20%3D%20%22NO%20FILE%22%20End%20If%20If%20C.Value%20%3D%20%22%22%20Then%20Exit%20Sub%20End%20If%20Next%20C%20Range(%22a1%22).Select%20Columns(1).EntireColumn.Delete%20End%20Sub%20Sub%20AddPic(sFile%20As%20String%2C%20r%20As%20Range)%20With%20r.Areas(1)%20ActiveSheet.Shapes.AddPicture%20FileName%3A%3DsFile%2C%20_%20LinkToFile%3A%3DmsoFalse%2C%20_%20SaveWithDocument%3A%3DmsoTrue%2C%20_%20Top%3A%3D.Top%2C%20Left%3A%3D.Left%2C%20_%20Height%3A%3D45%2C%20Width%3A%3D45%20End%20With%20End%20Sub%20Private%20Function%20File_Exists(ByVal%20sPathName%20As%20String%2C%20Optional%20Directory%20As%20Boolean)%20As%20Boolean%20'Returns%20True%20if%20the%20passed%20sPathName%20exist%20'Otherwise%20returns%20False%20On%20Error%20Resume%20Next%20If%20sPathName%20%26lt%3B%26gt%3B%20%22%22%20Then%20If%20IsMissing(Directory)%20Or%20Directory%20%3D%20False%20Then%20File_Exists%20%3D%20(Dir%24(sPathName)%20%26lt%3B%26gt%3B%20%22%22)%20Else%20File_Exists%20%3D%20(Dir%24(sPathName%2C%20vbDirectory)%20%26lt%3B%26gt%3B%20%22%22)%20End%20If%20End%20If%20End%20Function%3C%2FP%3E%3C%2FLINGO-BODY%3E
brady
Occasional Contributor

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 

8 Replies

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.

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!

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?

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

@Matt Mickle the locations for the 6 other images are as follows:

and all on same worksheet.
.Left = ActiveSheet.Range("q3").Left
.Top = ActiveSheet.Range("q3").Top
.Width = ActiveSheet.Range("q4:q8").Width
.Height = ActiveSheet.Range("r4:r8").Height .Placement = 1

2
.Left = ActiveSheet.Range("q33").Left
.Top = ActiveSheet.Range("q33").Top
.Width = ActiveSheet.Range("q33:q38").Width
.Height = ActiveSheet.Range("r33:r38").Height

3
.Left = ActiveSheet.Range("q63").Left
.Top = ActiveSheet.Range("q63").Top
.Width = ActiveSheet.Range("q63:q68").Width
.Height = ActiveSheet.Range("r68:r68").Height

They are all about 30 cell spaces lower and I have 7 total. In additional I have a sheet labeled Title Page and there 1 image there with the follow location.
Title Page
.Left = ActiveSheet.Range("B3").Left
.Top = ActiveSheet.Range("B3").Top
.Width = ActiveSheet.Range("B3:b9").Width
.Height = ActiveSheet.Range("e9:e9").Height

Thank you for your help!

 

@dklein_14 

 

Try the below code example which loops through multiple locations on the worksheet.  I have commented the code for better understanding.

 

You may want to  note that when you set the width to a value like B3:B9 that is will simple make the image the length of the B column or similarly for E9:E9 it will make the height of the image the height  of cell E9.

 

Sub GetPic()

Dim fNameAndPath     As Variant
Dim img              As Picture
Dim intLp            As Integer
Dim arrLeftandTop    As Variant
Dim arrWidth         As Variant
Dim arrHeight        As Variant

fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported") 'Open FIle Dialog to allow user to pick picture
If fNameAndPath = False Then Exit Sub 'If the user cancels then exit the procedure....

    'Define the different range arrays
    arrLeftandTop = Array("B3", "Q3", "Q33", "Q63") 'Left and top range values
    arrWidth = Array("B3:B9", "Q4:Q8", "Q33:Q38", "Q63:Q68") 'Width range values
    arrHeight = Array("E9:E9", "R4:R8", "R33:R38", "R68:R68") 'Height range values
    
    'Loop through ranges and place pictures one at a time....
    'Note arrays start at 0
    ' arrLeftandTop(0) = "B3"
    ' arrLeftandTop(1) = "Q3"
    '.....etc
    For intLp = 0 To 3
    
        Set img = ActiveSheet.Pictures.Insert(fNameAndPath) 'Set image for insert
        With img
           'Resize Picture to fit in the range....
           .Left = ActiveSheet.Range(arrLeftandTop(intLp)).Left
           .Top = ActiveSheet.Range(arrLeftandTop(intLp)).Top
           .Width = ActiveSheet.Range(arrWidth(intLp)).Width
           .Height = ActiveSheet.Range(arrHeight(intLp)).Height
           .Placement = 1
           .PrintObject = True
        End With
    
    Next intLp 'Go to next array value... i.e. first loop is 0, next loop is 1....etc.
    
End Sub

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. 

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

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
46 Replies
Extentions Synchronization
Deleted in Discussions on
3 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
30 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies