m scrivi ps pdf campi

Attribute VB_Name = "m_scrivi_ps_pdf_campi"

'

Option Explicit

'

' crea griglia editabile per file pdf

' genera un file in formato PS-postscript

' tramite Ghostscript si crea il file in formato PDF

'

Sub ScriviFilePsPdfCampiEditabili()

Dim orizzontale, verticale, altezzacampo, lunghezzacampo

Dim contaaltezza, contacampi

Dim marginesinistro, partida, s As String

Dim lunghezzacampi, nomecampi, destinatarioemail

destinatarioemail = InputBox("destinatario email", "scelta", "")

Dim x, spostati

altezzacampo = 20

'lunghezzacampo = 30

orizzontale = 595 ' formato pagina a4

verticale = 842 ' formato pagina a4

marginesinistro = 21

partida = verticale - altezzacampo - altezzacampo - altezzacampo

contacampi = 0

'

nomecampi = Array("", "qta", "articolo", "descrizione", "nota", "note")

'

lunghezzacampi = Array(0, 35, 150, 250, 45, 70)

'

s = ""

s = s & "%!PS-Adobe-3.0 EPSF-3.0" & vbCrLf

s = s & "%%BoundingBox: 0 0 72 72" & vbCrLf

s = s & "%%EndComments" & vbCrLf

s = s & "%%BeginProlog /pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse " & "[ {ThisPage} << /Trans << /S /Dissolve >> >> /PUT pdfmark" & vbCrLf

s = s & "%%EndProlog" & vbCrLf

s = s & " " & vbCrLf

s = s & "%%BeginSetup" & vbCrLf

s = s & "%%EndSetup" & vbCrLf

s = s & " " & vbCrLf

s = s & "%%BeginPage:" & vbCrLf

s = s & " " & vbCrLf

'

spostati = marginesinistro

' intestazione della griglia

For x = 1 To UBound(lunghezzacampi)

lunghezzacampo = lunghezzacampi(x)

s = s & "/Times-Roman findfont 10 scalefont setfont" & vbCrLf

s = s & spostati & " 810 moveto" & vbCrLf

s = s & "(" & nomecampi(x) & ") show" & vbCrLf

spostati = spostati + lunghezzacampo + 2

Next x

' crea griglia

' campi editabili

For x = 1 To UBound(lunghezzacampi)

lunghezzacampo = lunghezzacampi(x)

For contaaltezza = partida To 61 Step -21

s = s & " " & vbCrLf

s = s & "[ /T (field" & nomecampi(x) & contacampi & x & ") % title" & vbCrLf

s = s & "/Subtype /Widget" & vbCrLf

s = s & "/FT /Tx % field type text box" & vbCrLf

s = s & "/V () % default value" & vbCrLf

's = s & "/Rect [ 25 619 116 639]" & vbCrLf

s = s & "/Rect [ " & marginesinistro & " " & contaaltezza & " " & (marginesinistro + lunghezzacampo) & " " & (contaaltezza + altezzacampo) & " ]" & vbCrLf

s = s & "/F 4 % field is printable" & vbCrLf

s = s & "/BS << /S /S /W 1 >> % border style solid, width = 1" & vbCrLf

s = s & "/MK <<" & vbCrLf

s = s & "/BC [ 1 0 0 ] % border color red" & vbCrLf

s = s & "/BG [ 1 1 1 ] >> % background color white" & vbCrLf

s = s & "/ANN pdfmark" & vbCrLf

s = s & " " & vbCrLf

contacampi = contacampi + 1

Next contaaltezza

'

marginesinistro = marginesinistro + lunghezzacampo + 1

'

Next x

'

' pulsante invio modulo tramite email

'

s = s & "[ /Rect [ 50 50 220 60 ]" & vbCrLf

s = s & "/Action << /Subtype /SubmitForm" & vbCrLf

s = s & "/F (mailto:" & destinatarioemail & ") >>" & vbCrLf

s = s & "/Flags 0" & vbCrLf

s = s & "/Subtype /Link" & vbCrLf

s = s & "/Border [ 1 1 1 ]" & vbCrLf

s = s & "/ANN pdfmark" & vbCrLf

'

s = s & "/Times-Roman findfont 10 scalefont setfont" & vbCrLf

s = s & "52 52 moveto" & vbCrLf

s = s & "(invia tramite e-mail) show" & vbCrLf

s = s & "showpage" & vbCrLf

'

s = s & "%%EndPage:" & vbCrLf

s = s & "%%EOF" & vbCrLf

'

' scrive il file ps

Dim fs, a

Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile("c:\file-per-creazione-pdf.ps", True)

a.WriteLine (s)

a.Close

'

End Sub