Excelfeld definieren für PDF Signaturfeld
21.11.2024 08:04:03
Nadine
ich habe ein Formular, was per Makro als PDF umgewandelt und 2 Signaturfelder an einer bestimmten Stelle eingefügt werden soll.
Leider wird die Darstellung der beiden Signaturfelder an jedem PC anders eingefügt. Ich habe dann eine Gruppe erstellt, worein dann die Signaturfelder per Makro eingefügt werden. In der Hoffnung, dass es bei jedem PC (egal welche Auflösung, Darstellung) diese immer an derselben Stelle sind.
https://www.herber.de/bbs/user/173744.xlsm
Danke Nadine
Sub Signatur_einfügen()
On Error GoTo Err_Handler
Dim pdfPDDoc As Object
Dim oJS As Object
strVerzeichnis = "H:\"
strFilename = "Mehrarbeit_" & ActiveSheet.Range("H6") & "_" & ActiveSheet.Range("A1") & ".pdf"
strFName1 = strVerzeichnis & strFilename
strFName2 = strVerzeichnis & strFilename
On Error GoTo Err_Handler
Set pdfPDDoc = CreateObject("AcroExch.PDDoc")
If pdfPDDoc.Open(strFName1) Then
Set oJS = pdfPDDoc.GetJSObject
'Signature-Feld 1
Set oSign = oJS.AddField("SignatureField1", "signature", 0, Array(X_Y_Position(1), X_Y_Position(2), X_Y_Position(3), X_Y_Position(4)))
'Signature-Feld 2
Set oSign = oJS.AddField("SignatureField2", "signature", 0, Array(X_Y_Position(5), X_Y_Position(6), X_Y_Position(7), X_Y_Position(8)))
'Speichern
pdfPDDoc.Save 1, strFName2
End If
GoTo Finaly
Exit_Proc:
Exit Sub
Err_Handler:
MsgBox "In test" & vbCrLf & Err.Number & "--" & Err.Description
Resume Exit_Proc
Finaly:
End Sub
Private Function X_Y_Position(WhichPositionInArray As Integer) As Integer
Select Case WhichPositionInArray
Case 1: X_Y_Position = ActiveSheet.Shapes("Signatur Ersteller").TopLeftCell.Top
Case 2: X_Y_Position = ActiveSheet.Shapes("Signatur Ersteller").TopLeftCell.Left
Case 3: X_Y_Position = ActiveSheet.Shapes("Signatur Ersteller").TopLeftCell.bottom
Case 4: X_Y_Position = ActiveSheet.Shapes("Signatur Ersteller").TopLeftCell.Right
Case 5: X_Y_Position = ActiveSheet.Shapes("Signatur Vorgesetzter").TopLeftCell.Top
Case 6: X_Y_Position = ActiveSheet.Shapes("Signatur Vorgesetzter").TopLeftCell.Left
Case 7: X_Y_Position = ActiveSheet.Shapes("Signatur Vorgesetzter").TopLeftCell.bottom
Case 8: X_Y_Position = ActiveSheet.Shapes("Signatur Vorgesetzter").TopLeftCell.Right
End Select
End FunctionAnzeige