How to create signable pdf straight out of Word/PoerPoint/Excel using pdfmark

I know this is old but figure I would post I can it helps someone.

I use print to PDF and VBA code, but you could just extract the PDFmark from the code and insert it into the document as a PRINT field code.

In my template, I insert tags (date_block, signature_block) that tell the VBA code where to place the fields.

The field code is inserted at the end of the document.

I use VBA to change the tags to a white color, which basically hides then in the PDF, and then change them back to black.

A button was placed inside a textbox and added to the header of the document, and the textbox is hidden when printing so it doesn't show the button in the PDF.

In the code below, you will want to play with the math to meet your needs, or statically set the values.

Code:

private function GeneratePDF

    Dim Document As Document

    Dim field As field

    Dim shape As shape

    Dim textOffsetX As Double

    Dim textOffsetY As Double

    Dim textWidthX As Double

    Dim textWidthY As Double

    Dim textWidth As Double

    Dim textHeigth As Double

    Dim x, y As Double

    Dim i As Integer

    Dim page As Integer

    Dim tmp As String

    Set Document = Word.ActiveDocument

    i = 1

    ' Delete previous print field codes

    For Each field In Document.Fields

        If InStr(1, field.Code, "PRINT") > 0 Then

            field.Delete

        End If

    Next

    '--------------------------------

    ' Process date tags

    '--------------------------------

    Selection.HomeKey Unit:=wdStory

    With Selection.Find

        .MatchCase = False

        .MatchWholeWord = True

        .MatchWildcards = False

        .Execute FindText:="date_block"

        Do While .Found

            Selection.Select

            Selection.Font.ColorIndex = wdWhite

            ' get text x coordinate and convert points to twips

            textOffsetX = Selection.Information(wdHorizontalPositionRelativeToPage) * 16.6

            textWidth = (Selection.End - Selection.Start) * 91.3

            x = textOffsetX + textWidth

            ' get text y coordinate and convert points to twips

            textOffsetY = Selection.Information(wdVerticalPositionRelativeToPage) * 16.6

            y = textOffsetY + PointsToPixels(12, True) * 16.6

            ' add textbox field codes

            page = Selection.Information(wdActiveEndPageNumber)

            tmp = tmp & """[/Subtype /Widget /SrcPg " & page _

                & "/Rect [" & textOffsetX & " " & textOffsetY & " " & x & " " & y & "] /F 4 /T (Date_" & i _

                & ") /FT /Tx /MK << /BG [ 1 1 1 ] >> /DA (/TimesNewRoman 12 Tf [0 0 0] rg) /Q 2 " _

                & "/V (" & Format(Now(), "dd mmm yy") & ") /ANN pdfmark """

            ' update counter

            i = i + 1

            ' search for more date tags

            .Execute FindText:="date_block"

        Loop

    End With

    'reset counter

    i = 1

    '-------------------------------

    ' Process signature tags

    '-------------------------------

    Selection.HomeKey Unit:=wdStory

    With Selection.Find

        .MatchCase = False

        .MatchWildcards = True

        .Execute FindText:="signature_block"

        Do While .Found

            Selection.Select

            Selection.Font.ColorIndex = wdWhite

            ' get shape x coordinate and convert points to twips

            textOffsetX = Selection.Information(wdHorizontalPositionRelativeToPage) * 16.6

            textWidth = (Selection.End - Selection.Start) * 175

            x = textOffsetX + textWidth

            ' get shape y coordinate and convert points to twips

            textOffsetY = Selection.Information(wdVerticalPositionRelativeToPage) * 16.6

            y = textOffsetY + PointsToPixels(12, True) * 16.6

            ' add signature block field codes

            page = Selection.Information(wdActiveEndPageNumber)

            tmp = tmp & """[ /Subtype /Widget /SrcPg " & page _

                & " /Rect [ " & textOffsetX & " " & textOffsetY & " " & x & " " & y & " ] /T (SignatureBlock_" & i _

                & ") /FT /Sig /Ff 65540 /H /P /F 4 /BS << /W 1 /S /B >> /MK << /BC [ 0 0 0 ] >> " _

                & "/DA (/TimesNewRoman 12 Tf 0 0 0 rg) " _

                & "/ANN pdfmark """

            ' update counter

            i = i + 1

            ' search for more signature tags

            .Execute FindText:="signature_block"

        Loop

    End With

    '-------------------------------

    ' Add the require form code

    '-------------------------------

    Selection.EndKey Unit:=wdStory

    Document.Fields.Add range:=Selection.range, Type:=wdFieldPrint, Text:=tmp & """ [ /_objdef {pdfDocEncoding} /type /dict /OBJ pdfmark [ {pdfDocEncoding} << /Type /Encoding /Differences " _

        & "[ 24 /breve /caron /circumflex /dotaccent /hungarumlaut /ogonek /ring /tilde 39 /quotesingle 96 /grave " _

        & "128 /bullet /dagger /daggerdbl /ellipsis /emdash /endash /florin /fraction /guilsinglleft /guilsinglright " _

        & "/minus /perthousand /quotedblbase /quotedblleft /quotedblright /quoteleft /quoteright /quotesinglbase /trademark " _

        & "/fi /fl /Lslash /OE /Scaron /Ydieresis /Zcaron /dotlessi /lslash /oe /scaron /zcaron 164 /currency 166 /brokenbar " _

        & "168 /dieresis /copyright /ordfeminine 172 /logicalnot /.notdef /registered /macron /degree /plusminus /twosuperior " _

        & "/threesuperior /acute /mu 183 /periodcentered /cedilla /onesuperior /ordmasculine 188 /onequarter /onehalf /threequarters " _

        & "192 /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute " _

        & "/Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex " _

        & "/Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute " _

        & "/ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis " _

        & "/divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ] >> /PUT pdfmark " _

        & "[ /_objdef {ZaDb} /type /dict /OBJ pdfmark [ {ZaDb} << /Type /Font /Subtype /Type1 /Name /ZaDb /BaseFont /ZapfDingbats >> /PUT pdfmark " _

        & "[ /_objdef {Helv} /type /dict /OBJ pdfmark [ {Helv} << /Type /Font /Subtype /Type1 /Name /Helv /BaseFont /Helvetica /Encoding {pdfDocEncoding} >> /PUT pdfmark " _

        & "[ /_objdef {aform} /type /dict /OBJ pdfmark [ /_objdef {afields} /type /array /OBJ pdfmark [ {aform} << /Fields {afields} " _

        & "/DR << /Font << /ZaDb {ZaDb} /Helv {Helv} >> >> /DA (/Helv 0 Tf 0 g) /NeedAppearances true >> /PUT pdfmark [ {Catalog} << /AcroForm {aform} >> /PUT pdfmark """

    ' hide command button

    For Each shape In Document.range.ShapeRange

        If InStr(1, Replace(LCase(shape.Name), " ", ""), "textbox") > 0 Then

            ' hide shape before printing

            shape.Visible = False

        End If

    Next

    'print the document

    Document.PrintOut

    '-------------------------------

    ' reset text color to black

    '-------------------------------

    Selection.HomeKey Unit:=wdStory

    With Selection.Find

        .MatchCase = False

        .MatchWholeWord = True

        .MatchWildcards = False

        .Execute FindText:="date_block"

        Do While .Found

            Selection.Select

            Selection.Font.ColorIndex = wdBlack

            .Execute FindText:="date_block"

        Loop

    End With

    Selection.HomeKey Unit:=wdStory

    With Selection.Find

        .MatchCase = False

        .MatchWildcards = True

        .Execute FindText:="signature_block"

        Do While .Found

            Selection.Select

            Selection.Font.ColorIndex = wdBlack

            .Execute FindText:="signature_block"

        Loop

    End With

    ' unhide command button

    For Each shape In Document.range.ShapeRange

        If InStr(1, Replace(LCase(shape.Name), " ", ""), "textbox") > 0 Then

            shape.Visible = True

        End If

    Next

end function