Controle handtekening VBA met pennen in excel

[michael755]

Middag allemaal,

Heb jullie weer nodig .

Ik gebruik een servicerapport die ik in excel gemaakt heb.
Nu loop ik tegen een probleem aan, graag zou ik een handtekening controle willen uitvoeren.

Nu heb ik het volgende gebruikt.

If Not (Range("Tekst1") <> "") Then
MsgBox "Er is geen handtekening geplaatst !"
Exit Sub
End If


Het probleem is dat deze sub een letter wil zien ipv een handtekening.

De handtekening zal geplaatst worden over 12 vakjes (vrij kleine vakjes).

Is er een mogelijkheid om te controleren of er met een pen overheen is gegaan (Laptop met touch)?


Alvast hartelijk dank.

Groet, Michael

 

[alphamax]

Met een voorbeeldbestandje met handtekening wordt je sneller en beter geholpen.
Zo kunnen wij zien of het een shape is of een image of iets anders.

 

[michael755]

Oké hartelijk dank. Zal dat morgen in orde maken. Wel even een kortte uitleg alvast. Het heeft niks met een afbeelding te maken. Handtekening wordt rechtstreeks in de exel vakken geplaatst dmv een pen.

 

[michael755]

Bekijk bijlage hand test.xlsx

Bij deze een voorbeeld. hoe kan ik deze handtekening herkennen met vba? Als er een macro gestart zal worden dan wil ik dat er een handtekening staat. Het vak mag dus niet leeg zijn. De complete macro moet gestopt worden.

Alvast hartelijk dank voor de moeite.

 

[popipipo]

Sub tst()
Dim i As Integer
i = ActiveSheet.Shapes.Count
MsgBox "Er is /zijn " & i  & " handtekening(en) geplaatst!"
End Sub

Ik ben geen VBA specialist maar probeer het hier eens mee.

 

[michael755]

Beste Willem,

Hartelijk dank voor het meedenken, helaas werkt het niet.

Groetjes Michael

 

[alphamax]

Het is makkelijker wanneer je het orginele bestand met de code plaatst.
Deze heeft een inkpicture-control over de cellen staan, de code zet dit vervolgens om naar een afbeelding.
Er is ook code om te controleren hoeveel pennestreken er op de inkpicture-control zijn gemaakt.
Is dit aantal 0 dan is er ook geen handtekening.

 

[alphamax]

Andere manier, deze code kijkt in het bestand, als er geen witte pixel gevonden is dan is er een handtekening geplaatst (een kruisje is toch ook een handtekening).
Maakt gebruik van WIA.Imagefile (de windows software die je scanner aanstuurt).

[SIZE=1]Option Explicit

Private Sub CommandButton1_Click()
    Dim avntdata As Variant
    Dim iavntdata As Long
    Dim objShape As Object
    Dim strMessage As String
    Dim strTempFile As String
    strTempFile = Environ("TEMP") & "\temp.bmp"    'am_2016
    Set objShape = Shapes("Inkt 2")    'eventueel aanpassen
    With ChartObjects.Add(1, 1, objShape.Width, objShape.Height)    'sla image op via chartobject
        .Border.LineStyle = xlNone
        objShape.Copy
        .Chart.Paste
        .Chart.Export strTempFile, "bmp"
        .Delete
    End With
    Set objShape = Nothing
    With CreateObject("WIA.ImageFile")
        strMessage = "Niet Getekend"
        .LoadFile strTempFile
        Set avntdata = .ARGBData
        Do
            iavntdata = iavntdata + 1
            If (avntdata(iavntdata) And &HFFFFFF) <> RGB(255, 255, 255) Then    'ARGB naar RGB en geen witte pixel
                strMessage = "Getekend"
                Exit Do
            End If
        Loop While iavntdata < avntdata.Count
        Set avntdata = Nothing
        MsgBox strMessage
    End With
    Kill strTempFile
End Sub[/SIZE]

 

[michael755]

Alphamax,

Hartelijk dank voor het meedenken. Helemaal top. De oplossing werkt voor mij :thumb:

Super dat jullie dit allemaal doen voor de medemens .

Groetjes Michael

 

[alphamax]

Dank je, mocht je nog verder willen automatiseren stel dan een nieuwe vraag en verwijs dan ook naar deze vraag.