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
- Syntax error
- 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?