Inserting a picture from another sheet using VBA

[igytk]

Hi, I currently have a working macro (thanks to something I found on here!) that looks up a name typed in at a particular loaction, and then inserts an image with the same name (their signature) from a local folder. However, as I'm planning on sending the worksheet to these other people to 'Approve' the section of the main sheet (by typing in their name and a password) it would be much easier if the files were stored in a seperate sheet. I've been trying to update the macro to enable this, but can't get it to work!

Here is the original (working) macro, the name is in O965, the signature will be placed in BB965:

Sub QSK()
Dim pWord As String
Dim NewRow As Long
pWord = "xyz"
ActiveSheet.Unprotect Password:=pWord
Dim MyPictureFile As String
Dim MyCell As Range
Dim counter As Integer
counter = 965
Do While ActiveSheet.Range("O" & counter) <> 0
If ActiveSheet.Range("BB" & counter) = "Approved" Then
If ActiveSheet.Range("O" & counter) <> 0 Then
namedcell = ActiveSheet.Range("O" & counter).Value
If FileFolderExists("C:\Documents and Settings\...\My Pictures\" & namedcell & ".JPG") Then
MyPictureFile = "C:\Documents and Settings\...\My Pictures\" & namedcell & ".JPG"
With ActiveSheet
Set MyCell = .Range("BB" & counter)
    ActiveSheet.Pictures.Insert(MyPictureFile).Select
    Selection.ShapeRange.ScaleWidth 0.42, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.42, msoFalse, msoScaleFromTopLeft
    Application.CommandBars("Picture").Visible = False
    ActiveWindow.SmallScroll Down:=-9
    
'---------------------------------------------------------------------
With MyCell
Selection.Top = .Top
Selection.Left = .Left
Selection.Width = .Width
Selection.Height = .Height
Selection.Placement = xlMoveAndSize ' move and size with cells
Selection.PrintObject = True
'-------------------------------------------------------------
'Selection.ShapeRange.PictureFormat.Brightness = 0.5 ' various formats available
'-------------------------------------------------------------
'-
.Select ' change focus (selection) from picture to cell
End With
'---------------------------------------------------------------------
End With
End If
End If
End If
counter = counter + 1
Loop
ActiveSheet.Protect Password:=pWord
End Sub
Public Function FileFolderExists(strFullPath As String) As Boolean
'Macro Purpose: Check if a file or folder exists
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function

My attemped modification is below, 'Sigs' is where the signatures will be stored, bold is where the debugger is pointing (runtime error 1004):

counter = 965
Do While ActiveSheet.Range("O" & counter) <> 0
If ActiveSheet.Range("BB" & counter) = "Approved" Then
If ActiveSheet.Range("O" & counter) <> 0 Then
namedcell = ActiveSheet.Range("O" & counter).Value
Sheets("Sigs").Select
[B]MyPictureFile = ActiveSheet.Range(namedcell)
[/B]Sheets("Sheet2").Select
With ActiveSheet
Set MyCell = .Range("BB" & counter)
    ActiveSheet.Pictures.Insert(MyPictureFile).Select
    Selection.ShapeRange.ScaleWidth 0.42, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.42, msoFalse, msoScaleFromTopLeft
    Application.CommandBars("Picture").Visible = False
    ActiveWindow.SmallScroll Down:=-9

Thanks very much!

 

[Damon Ostrander]

Hi igytk,

My guess is that the value of namedcell is not what you think it is (not a valid named range on the Sigs sheet). You can check its value by simply placing the cursor over this variable name in the debugger when execution stops at the "MyPictureFile =" line.

Incidentally, it would be simpler, cleaner and execution more efficient if you directly referenced the worksheets rather than selecting them. For example, instead of

Sheets("Sigs").Select
MyPictureFile = ActiveSheet.Range(namedcell)
Sheets("Sheet2").Select
With ActiveSheet

use

MyPictureFile = Sheets("Sigs").Range(namedcell)
With Sheets("Sheet2")

 

[igytk]

Thanks for your response. I've tidied up the reference to the worksheets, cheers!

The value of the namedcell is shown as: namedcell="My Name"

Where "My Name" is the exact value of the cell being looked at (O965), and also the name of the picture in the Sigs sheet (does a picture count as a named range?). I've tried changing the

MyPictureFile = Sheets("Sigs").Range(namedcell)

line to

MyPictureFile = Sheets("Sigs").Shape(namedcell)

If I run it then, the runtime error changes to '438: Object doesn't support this property or method'. I'm guessing I haven't defined it properly to make it realise I want it to take the name in O965, then find a picture of that name, and insert it in BB965.