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

Question

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

我似乎无法将签名（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

我前些时候通过类似的事情。

你可以在这里看到我的问题。

下面的代码将允许您打开用户窗体，以便用户可以在墨水字段上签名，临时保存图像，将InkPicture添加到工作表中并取消临时图像。

设置您的UserForm（我的设置是这样，有几个附加选项），该UserForm名为Signature_pad ，您需要的基本选项是Private Sub Use_Click() 。

这是用户窗体中的代码：

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模块），您可以使用button调用此Sub或形成另一个Sub 。

'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 。