Userform VBA InkPicture输入到工作表（特定单元格）作为图像用户签名

Question

我是InkPicture的新手，但我喜欢用它来让用户将签名放入表单中。

我似乎无法将签名（墨迹图片）保存到电子表格中，只是将其输入为我指定的单元格中的0。

With UserForm1.InkPicture1.Picture = InkPicture1.Picture


End With

lrDep = Sheets("Deploy").Range("A" & Rows.Count).End(xlUp).Row 
Sheets("Deploy").Cells(lrDep + 1, "A").Value = TBox1.Text 
Sheets("Deploy").Cells(lrDep + 1, "B").Value = TBox2.Text 
Sheets("Deploy").Cells(lrDep + 1, "C").Value = TBox3.Text 
Sheets("Deploy").Cells(lrDep + 1, "D").Value = TBox4.Text 
Sheets("Deploy").Cells(lrDep + 1, "G").Value = InkPicture1.Ink 

有人可以帮助我。 谢谢。

Answer 1

我在一段时间之前经历过类似的事情。

您可以看到我的问题here。

以下代码将允许您打开用户窗体，以便用户可以对墨迹字段进行签名，温和地保存图像，将InkPicture添加到工作表中并终止临时图像。

设置UserForm（我的设置如此，有一些额外的选项）UserForm名为Signature_pad，您需要的基本选项是Private Sub Use_Click()。

这是Userform中的代码：

Private Sub Use_Click()

    Dim objInk As MSINKAUTLib.InkPicture
    Dim bytArr() As Byte
    Dim File1 As String

    FilePath = Environ$("temp") & "\" & "Signature.png"

    Set objInk = Me.SignPicture

    If objInk.Ink.Strokes.Count > 0 Then
        bytArr = objInk.Ink.Save(2)
        Open FilePath For Binary As #1
        Put #1, , bytArr
        Close #1
    End If

    Signature.File = FilePath

    Unload Me
End Sub
Private Sub Cancel_Click()
    End
End Sub
Private Sub ClearPad_Click()
    Me.SignPicture.Ink.DeleteStrokes
    Me.Repaint
End Sub

以下是调用用户表单并处理签名的Main sub（称为Signature的模块），您可以使用Sub调用此button或另一个{Sub 1}}。

'public temp file path
Public File
Sub collect_signature()

    'Dim and call userform
    Dim myUserForm As Signature_pad

    Set myUserForm = New Signature_pad
    myUserForm.Show
    Set myUserForm = Nothing

    'insert image/signature from temp file into application active sheet
    Set SignatureImage = Application.ActiveSheet.Shapes.AddPicture(File, False, True, 1, 1, 1, 1)

    'scale image/signature
    SignatureImage.ScaleHeight 1, True
    SignatureImage.ScaleWidth 1, True

    'image/signature position
    SignatureImage.Top = Range("A1").Top
    SignatureImage.Left = Range("A1").Left

    'delete temp file
    Kill File

End Sub

请务必重命名Userform Name和Buttons Name或代码以匹配您buttons的名称。