m scrivi fdf

Attribute VB_Name = "m_scrivi_fdf"

'

Option Explicit

'

' un unico file PDF per visualizzare i dati del foglio Excel

' i nomi dei campi del file Pdf debbono essere gli stessi

' presenti una prima riga del foglio excel.

' per ogni riga del foglio excel viene generato un file fdf.

'

' esempio file fdf:

'%FDF-1.2

'1 0 obj

'<<

' /FDF

' <<

' /Fields [

' << /V (1) /T (an_conto)>>

' << /V (nominativo) /T (an_descr1)>>

' << /V (indirizzo) /T (an_indir)>>

' << /V (cap) /T (an_cap)>>

' << /V (città) /T (an_citta)>>

' << /V (prov) /T (an_prov)>>

' ]

' /F (C:\\schedefdf\\scheda-dati.pdf)

' /ID [ ()()]

' >>

'>>

'endobj

'trailer

'<<

'/Root 1 0 R

'>>

'%%EOF

'

'



Sub ScriviFileFdf()

Dim quanterighe, contarighe, foglio, quantecolonne, contacolonne, risposta

Dim cartellascrittura

Dim intestazioni(), contenuti(), filepdf, filefdf

Set foglio = Sheets(ActiveSheet.Name)

'

' il nome del file pdf su cui visualizzare i dati del foglio

' i momi dei campi debbono essere gli stessi di quelli presenti sulla

cartellascrittura = "C:\schedefdf\"

risposta = VerificaEsistenzaCartella(cartellascrittura)

'

'cartellascrittura = InputBox("cartella dove scrivere file fdf:", "scelta", "c:\temp\")

' prima riga del foglio

filepdf = "C:\\lschedefdf\\scheda-dati.pdf"

'

' conteggio righe e colonne

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

quantecolonne = Range(foglio.UsedRange.Cells(1, foglio.UsedRange.Columns.Count).Address).Column

'

ReDim intestazioni(quantecolonne)

ReDim contenuti(quantecolonne)

'

contacolonne = 1

' utilizza i nomi inseriti nella prima riga come nome dei campi

'

While contacolonne <= quantecolonne

intestazioni(contacolonne) = foglio.Cells(1, contacolonne).Value

contacolonne = contacolonne + 1

Wend

'

contarighe = 1

'

While contarighe <= quanterighe

contacolonne = 1

While contacolonne <= quantecolonne

contenuti(contacolonne) = foglio.Cells(contarighe, contacolonne).Value

contacolonne = contacolonne + 1

Wend

' il file fdf prende il nome dal numero riga

filefdf = cartellascrittura & contarighe & ".fdf"

' in alternativa ii contenuto di una cella diventa il nome del file fdf.

' filefdf = cartellascrittura & trim(foglio.Cells(contarighe, "A").Value) & ".fdf"

Call funscrivifdf(intestazioni, contenuti, filepdf, filefdf)

contarighe = contarighe + 1

Wend

'

End Sub

'

Sub funscrivifdf(campi, valori, filepdf, filefdf)

Dim quanti, conta, nomecampo, valore

Dim s

quanti = UBound(campi)

s = ""

s = s & "%FDF-1.2" & vbCrLf

s = s & "1 0 obj" & vbCrLf

s = s & "<<" & vbCrLf

s = s & " /FDF" & vbCrLf

s = s & " <<" & vbCrLf

'

s = s & " /Fields [ " & vbCrLf

For conta = 1 To quanti

nomecampo = campi(conta)

valore = valori(conta)

s = s & " << /V (" & valore & ") /T (" & nomecampo & ")>>" & vbCrLf

Next conta

'

s = s & " ]" & vbCrLf

'

s = s & " /F (" & filepdf & ")" & vbCrLf

s = s & " /ID [ ()()]" & vbCrLf

s = s & " >>" & vbCrLf

s = s & ">>" & vbCrLf

s = s & "endobj" & vbCrLf

s = s & "trailer" & vbCrLf

s = s & "<<" & vbCrLf

s = s & "/Root 1 0 R" & vbCrLf

s = s & ">>" & vbCrLf

s = s & "%%EOF" & vbCrLf

'

Dim fs, a, archivio

archivio = filefdf

Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile(archivio, True)

a.WriteLine (s)

a.Close

'

End Sub

'

Function VerificaEsistenzaCartella(cartella)

Dim fso, msg, crea

Set fso = CreateObject("Scripting.FileSystemObject")

If (fso.FolderExists(cartella)) Then

' esiste

Else

' non esiste e cre la cartella

Set crea = fso.CreateFolder(cartella)

End If

'

End Function

'