VBA to insert picture into multiple worksheets relative to Print_area

MuppetReaper

New Member
Joined
Jun 14, 2013
Messages
30
I want to be able to insert a picture into each worksheet of a workbook, but I don't want the picture in a cell, I want it in a location relative to the Print_area (as the number of columns changes in each ws)
The picture can be the same size in each ws, but just needs to be located in the top right (with a small margin) of the ws.
And I need it to loop through all ws's with a defined Print_area
Is this at all possible?
All I can seem to find is to insert into a cell, which I don't think will work in this case, but am willing to be proven wrong!
Thanks all
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,165
Try...

Code:
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] InsertPicturesAtTopRightPrintArea()

    [COLOR=darkblue]Dim[/COLOR] sPathAndFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] sPrintArea [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] shp [COLOR=darkblue]As[/COLOR] Shape
    [COLOR=darkblue]Dim[/COLOR] rPrintArea [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Const[/COLOR] Gap [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR] = 5 [COLOR=green]'top and right margins[/COLOR]
    
    [COLOR=darkblue]If[/COLOR] ActiveWorkbook [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    sPathAndFile = "C:\Users\Domenic\Pictures\about.jpg" [COLOR=green]'change path and filename accordingly[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] ActiveWorkbook.Worksheets
        sPrintArea = ws.PageSetup.PrintArea
        [COLOR=darkblue]If[/COLOR] Len(sPrintArea) > 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Set[/COLOR] rPrintArea = ws.Range(sPrintArea)
            [COLOR=darkblue]Set[/COLOR] shp = ws.Shapes.AddPicture(Filename:=sPathAndFile, linktofile:=msoFalse, _
                SaveWithDocument:=msoTrue, Left:=rPrintArea.Left, Top:=rPrintArea.Top + Gap, Width:=-1, Height:=-1)
            shp.Left = rPrintArea.Left + rPrintArea.Width - shp.Width - Gap
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] ws
    
    MsgBox "Completed...", vbInformation
    
    [COLOR=darkblue]Set[/COLOR] ws = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] shp = [COLOR=darkblue]Nothing[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rPrintArea = [COLOR=darkblue]Nothing[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Hope this helps!
 

Watch MrExcel Video

Forum statistics

Threads
1,099,013
Messages
5,466,022
Members
406,461
Latest member
Garrus

This Week's Hot Topics

Top