Picture fun

[dumbitdown]

I'm trying to copy several cells from one workbook and paste them in another as a picture

Once it's pasted in to the new workbook I want to be able to resize it - this is where I'm getting stuck

Any help anyone can provide would be much appreciated...

 

[royUK]

Which version of Excel are you using? The new versions have a Copy as Picture feature available in the Home Tab

 

[dumbitdown]

I'm using excel 2007 - the copying and pasting aren't an issue

It's the resizing I'm having problems with...

 

[royUK]

What issues are you having. I've just psetd an image of a Table into a sheet & dragged it to a bigger size. Obviously there will be a limit to the size

 

[dumbitdown]

HAHA!! sorry I'm such an idiot, I'm using VBA to do it!!! Just shows what kind of day I'm having right now...

 

[royUK]

Can you adapt this? You could save the range as an image first

Option Explicit


'With the macro below you can insert pictures and fit them to any range in a worksheet.


Sub TestInsertPictureInRange()
    Dim picToOpen As String
    picToOpen = Application _
                .GetOpenFilename("Pics (*.jpg), *.jpg")
    If picToOpen <> "" Then InsertPictureInRange picToOpen, _
       Range("B5:D10")
End Sub


Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
End Sub