Electronic Signature

[vman5781]

All,

I am trying to set up a spreadsheet where each tab "belongs" to a individual, and would like to set up a "button" they can click that will grab a "signature image" from their files and insert in that spot. I have gone thru the post and was able to find the below code but it is giving me a 400 error when I try to run it.

[TABLE="width: 867"]
<tbody>[TR]
[TD]Sub SigButton_click()[/TD]
[/TR]
[TR]
[TD] ActiveSheet.Pictures.Insert("C:\Users\user name\Pictures\My Pictures\Signature.JPG").Select[/TD]
[/TR]
[TR]
[TD] ActiveSheet.Shapes.Range(Array("SigButton")).Delete[/TD]
[/TR]
[TR]
[TD]End Sub


Any Help or suggestions?


John[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]

 

[hotabae]

Re: Electrnoic Signature

Sub SigButton_click()

ActiveSheet.Pictures.Insert("C:\Users\**********\Pictures\My Pictures\Signature.JPG").Select

ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Delete

End Sub

This is how I would do it, but also check to make sure the path is correct

 

[vman5781]

Re: Electrnoic Signature

Hi,

I tried your formula, and decided I didn't need the second line to delete the macro button, so I have removed that from the macro and it is running fine with the exception that when the signature comes is it goes into the upper left corner and is real small. Is there a way to have the signature come in, and automatically size to the cell that it is coming into?

Thank you

John

 

[hotabae]

Re: Electrnoic Signature

Umm... Try this. All you should have to do is change the path (pictureSource) and the cell the sig is going into (outputCell)

This will morph the signature image to fit into the existing cell (which may have some unintended side effects)

Another note, I used "ActiveSheet", so the macro will only work properly if run while the correct sheet is active.
(This shouldn't be a problem if you are still using the button)

Sub test()
    
    Dim pictureSource As String
    pictureSource = "C:\Users\**********\Pictures\My Pictures\Signature.JPG"
        
    Dim outputCell As String
    outputCell = "G9"
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    With ws.Pictures.Insert(pictureSource)
    
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = ws.Range(outputCell).Left
        .Top = ws.Range(outputCell).Top
        .Width = ws.Range(outputCell).Width
        .Height = ws.Range(outputCell).Height
        .Placement = 1
        .PrintObject = True
        
    End With

End Sub

 

[vman5781]

Re: Electrnoic Signature

Phil,

Works great -- but still have one issue - Let's Say "Joe" goes into the workbook verifies what he needs to do , and using the macro inserts is signature and saves the work book. Right now, if I go into the workbook after Joe, my signature will show in Joe's spot. How can I lock the cell after inserting the signature?

Thank you

 

[hotabae]

Re: Electrnoic Signature

Ummm, I don't really have a way to test this, but I think it will work.

Based on this thread: https://stackoverflow.com/questions/17110425/vba-to-insert-embedded-picture-excel

I modified my code and it should work like this:

Sub test()
    
Dim pictureSource As String
pictureSource = "C:\Users\**********\Pictures\My Pictures\Signature.JPG"
    
Dim outputCell As String
outputCell = "G9"

Dim ws As Worksheet
Set ws = ActiveSheet[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]With ws.Range(outputCell)
[/COLOR]
[COLOR=#0000ff]    ws.Shapes.AddPicture Filename:=pictureSource, _
        linktofile:=msoFalse, savewithdocument:=msoTrue, _
        Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height
    
End With[/COLOR]
    
End Sub

 

[vman5781]

Re: Electrnoic Signature

hotabae

I tried the above code (changed a couple of things) but am getting a debugging error at the ws.range output cell

code:
Sub test()

Dim pictureSource As String
pictureSource = "g:\signature\Signature.JPG"

Dim outputCell As String
outputCell = "ActiveCell"

Dim ws As Worksheet
Set ws = ActiveSheet

With ws.Range(outputCell)

ws.Shapes.AddPicture Filename:=pictureSource, _
linktofile:=msoFalse, savewithdocument:=msoTrue, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height

End With

End Sub



Do you have any ideas?

 

[shg]

Sub test()
  With ActiveCell
    .Worksheet.Shapes.AddPicture Filename:="G:\signature\Signature.jpg", _
                                 LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, _
                                 Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height
  End With
End Sub