Load UserForm InkPicture with Ink saved in Excel worksheet

[zeus]

Hello,
I have struck out all day trying to find an answer to my problem. I would really appreciate any assistance that you can offer.
I have a UserForm with an InkPicture that I am using for approval signatures. Long story short, I have been able to save the ink strokes to the active Excel workbook, Sheet1, and what I need to do next is figure out how to load that image/strokes from the Excel worksheet back into the InkPicture when the file is reopened. Here is the code I used when saving the InkPicture strokes to the Excel sheet:

Me.InkPicture1.ink.ClipboardCopy
ActiveSheet.Paste
Set newImg = Selection
With newImg
.Top = 10
.Left = 10
.Name = "Signature"
End With

Thank you if you have any thoughts to share!

 

[zeus]

ok, thank you for your responses. I'll keep trying and if i find the solution, I'll post what I discover.

 

[Jaafar Tribak]

ok, thank you for your responses. I'll keep trying and if i find the solution, I'll post what I discover.

Stay tuned ... I'll post some code later when I get home.

 

[Jaafar Tribak]

Ok- This worked for me but may need some tweaking .

Workbook example

Code goes in the UserForm Module :

Option Explicit

Private Type uPicDesc
    Size As Long
    Type As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
       hPic As Long
       hPal As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long

    Private hCopy As LongPtr, hPtr As LongPtr, hLib As LongPtr

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 

    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

    Private hCopy As Long, hPtr As Long, hLib As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Const IMAGE_BITMAP = 0
Private Const PICTYPE_BITMAP = 1
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2
Private Const S_OK = 0

Private oInitPic As IPicture
Private oCurrentShape As Object



Private Sub UserForm_Initialize()
    InkPicture1.DefaultDrawingAttributes.Color = vbRed
    Set oInitPic = CreatePicture(Me.InkPicture1)
End Sub
      

Private Sub UserForm_Terminate()
    If Not oCurrentShape Is Nothing Then oCurrentShape.Delete
End Sub


Private Sub Cmd_CopyToSheet_Click()

    If Me.InkPicture1.Ink.Strokes.Count Then
        Me.InkPicture1.Ink.ClipboardCopy
        Range("B2").PasteSpecial xlPasteAll
        Set oCurrentShape = Selection
        oCurrentShape.TopLeftCell.Select
        Me.InkPicture1.Ink.DeleteStrokes
    Else
        If Not oCurrentShape Is Nothing Then
            Set Me.InkPicture1.Picture = oInitPic
            oCurrentShape.Visible = True
        End If
    End If
    Me.InkPicture1.AutoRedraw = True

End Sub


Private Sub Cmd_CopyFromSheet_Click()

    InkPicture1.SizeMode = IPSM_CenterImage
    Set InkPicture1.Picture = CreatePicture(oCurrentShape)
    If Me.InkPicture1.Ink.Strokes.Count = 0 Then
        If Not oCurrentShape Is Nothing Then
            oCurrentShape.Visible = False
        End If
    End If
    
End Sub


Private Function CreatePicture(ByVal Shape As Object) As IPicture

    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
    Dim iPic As IPicture, lRet As Long
    
    On Error GoTo errHandler

    Shape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hCopy
        .hPal = 0
    End With
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, iPic)
    Else
        lRet = OleCreatePictureIndirectPro(uPicinfo, IID_IDispatch, True, iPic)
    End If
    FreeLibrary hLib
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
errHandler:
    EmptyClipboard
    CloseClipboard
    
End Function