0

I am creating a visitor log, but I'm having trouble getting the e-signature into the desired column on a worksheet. I've been browsing and referring to a lot of threads here, but I feel like I'm losing it. Here's my code for Userform:

Private Sub OnlyNumbers()
    If TypeName(Me.ActiveControl) = "TextBox" Then
        With Me.ActiveControl
            If Not IsNumeric(.Value) And .Value <> vbNullString Then
                MsgBox "Sorry, only numbers allowed"
                .Value = vbNullString
            End If
        End With
    End If 
End Sub

Private Sub TIMEINBOX_Change()
    OnlyNumbers
End Sub
Private Sub TIMEOUTBOX_Change()
    OnlyNumbers
End Sub

Private Sub Userform_Initialize()
  DATEBOX.Value = Date
End Sub
Private Sub Submit_Click()

'''''''''''''''''' Validations ''''''''''''''''''''''''

If Me.NAMEBOX.Value = "" Or Me.ORGBOX.Value = "" Or Me.DATEBOX.Value = "" _
Or Me.PURPOSEBOX.Value = "" Or Me.TIMEINBOX.Value = "" Or Me.TIMEOUTBOX.Value = "" Then
    MsgBox "Please complete all columns", vbCritical
    Exit Sub
End If

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Data")

Dim row_number As Long
Dim max_id As Long
max_id = Application.WorksheetFunction.Max(sh.Range("A:A"))
 
If Me.txt_id.Value = "" Then  ''' Insert
    row_number = Application.WorksheetFunction.CountA(sh.Range("A:A")) + 1
    sh.Range("A" & row_number).Value = max_id + 1
    sh.Range("B" & row_number).Value = DATEBOX.Value
Else                          '''' Update
    row_number = Application.WorksheetFunction.Match(Int(Me.txt_id.Value), sh.Range("A:A"), 0)
End If


sh.Range("C" & row_number).Value = Me.NAMEBOX.Value
sh.Range("D" & row_number).Value = Me.ORGBOX.Value
sh.Range("E" & row_number).Value = Me.PURPOSEBOX.Value
sh.Range("F" & row_number).Value = Me.TIMEINBOX.Value
sh.Range("G" & row_number).Value = Me.TIMEOUTBOX.Value


    Me.NAMEBOX.Value = ""
    Me.ORGBOX.Value = ""
    Me.PURPOSEBOX.Value = ""
    Me.TIMEINBOX.Value = ""
    Me.TIMEOUTBOX.Value = ""
    Me.txt_id.Value = ""
    Me.SIGNPICTURE.Ink.DeleteStrokes
    Me.Repaint

    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

    
    Set SignatureImage = Application.ActiveSheet.Shapes.AddPicture(File, False, True, 1, 1, 1, 1)

    SignatureImage.Left = sh.Range("H" & row_number).Left
    Signature.Image.Top = sh.Range("H" & row_number).Top
    
    MsgBox "Submitted successfully", vbInformation
End Sub
Private Sub Clear_Click()
    Me.NAMEBOX.Value = ""
    Me.ORGBOX.Value = ""
    Me.PURPOSEBOX.Value = ""
    Me.TIMEINBOX.Value = ""
    Me.TIMEOUTBOX.Value = ""
    Me.txt_id.Value = ""
    Me.SIGNPICTURE.Ink.DeleteStrokes
    Me.Repaint
End Sub

Here's the code that triggers either

  1. Syntax error
  2. Run-time error '1004': Application-defined or object-defined error
    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

    
    Set SignatureImage = Application.ActiveSheet.Shapes.AddPicture(File, False, True, 1, 1, 1, 1)

    SignatureImage.Left = sh.Range("H" & row_number).Left
    Signature.Image.Top = sh.Range("H" & row_number).Top
    
    MsgBox "Submitted successfully", vbInformation
End Sub

Any experts with experience in inkpicture here able to help a newbie out?

Ken White
  • 123,280
  • 14
  • 225
  • 444
999G
  • 1

0 Answers0