Contenue des Champs d'un Document Notes vers PDF

Contenue des Champs d'un Document Notes vers PDF

Messagepar gouff » 28 Oct 2009 à 10:35

Permet d'envoyer le contenus de champs notes vers un formulaire pdf via un fichier fdf.

Le but de la manoeuvre est donc de créer un fichier fdf qui contient tous les champs à mapper dans un formulaire pdf (créé au préalable)

C'est un peu brut de fonderie, si tu veux plus d'explication fait moi signe


Code : Tout sélectionner
'*-
'* Traitement de convertion des données Notes vers formulaire Acrobat
'*-
Public Function ImprimeAcrobat ( docctx As notesdocument,doctyp As notesdocument,erreur As String ) As Integer
   Dim unid As String
   Dim dbcour As notesdatabase
   
   Dim tabofimg() As String
   Dim k As Integer
   
   unid = docctx.universalID
   Set dbcour=docctx.ParentDatabase
   
   ImprimeAcrobat% = False
   
   'On Error Goto FinAnormale
   
   '*-- Récupérer le document de paramétrage
   Dim vueall As NotesView
   Dim doccnf As NotesDocument
   Set vueall = dbcour.GetView ( "ALL" )
   If Not (vueall Is Nothing) Then _
   Set doccnf = vueall.GetDocumentByKey ( "CFG" )
   If (vueall Is Nothing) Or (doccnf Is Nothing) Then
      erreur="Document de configuration général introuvable"
      Exit Function
   End If
   
     '*-- Récupérer le document à imprimer
   Dim doctrt As NotesDocument
   Set doctrt = dbcour.Getdocumentbyunid ( unid$ )
   
   If (doctrt Is Nothing) Then
      erreur="Aucun document n'a été sélectionné"
      Exit Function
   End If
   
   
     '*-- Créer fichier FDF
   Dim accfic As String
   Dim reptmp As String
   Dim hfic As Integer
   Dim version As String
   Dim LibPDF As Variant
   Dim ValPDF As Variant
   Dim ListeVal List As String
   version = doctyp.version(0)
   
   If version = "Longue" Then
      k=1
   Else
      k=2
   End If
   
   While (k<=2)
      
      hfic% = Freefile()
      accfic$ = GenereFichierUnique$ ( dbcour, doctrt,docTyp.Version(0),hfic%, reptmp$,k )
      
      If (accfic$ = "") Then
         erreur$ = "Erreur de création du fichier .FDF"
         Exit Function
      End If
      
      Call inserPicto(tabofimg() , doctrt ,doccnf,version)
      
      
     '*-- Le renseigner en fonction du document à traiter
      Call EcrireEntete ( hfic% )
      If (GenererTableauValeur (dbcour, Doctrt, docTyp.version(0), ListeVal,k,tabofimg()) = False) Then
         erreur$ = "Erreur génération tableau de valeur"
         Exit Function
      End If
      Call EcrireChamps ( hfic%, doctyp, doctrt,docTyp.version(0),ListeVal,tabofimg )
      Call EcrireAccesEtID ( hfic%, doctyp,doccnf)
      Call EcrireFin ( hfic% )
      
     '*-- Ecrire dans le fichier, le fermer
      Close #hfic%
      
  '*-- Intégrer le fichier FDF
      If (IntegreFichier% ( doctrt, accfic$, reptmp$ ) = False) Then
         erreur$ = "Intégration du fichier .FDF"
         Exit Function
      End If
      k=k+1
   Wend
   
   'Print "<script>location.href='"+urlaouv$+"'</script>"
   ImprimeAcrobat% = True
   
   Exit Function
   
FinAnormale:
   On Error Goto 0
   erreur$ = Error$ & ", L = " & Erl() & " de ImprimeAcrobat"
   
End Function


et voici les fonctions nécessaires pour écrire le fichier fdf
Code : Tout sélectionner
Private Sub EcrireEntete ( hfic As Integer )
     '*-- Attention aux ';' qui ne génèrent pas 0x0D 0x0A !
   Print #hfic%, "%FDF-1.2" & Chr$ (13);
   Print #hfic%, "%" & Chr$ (&HE2) & Chr$ (&HE3) & Chr$ (&HCF) & Chr$ (&HD3)
   Print #hfic%, "1 0 obj" & Chr$ (13);
   Print #hfic%, "<< " & Chr$ (13);
End Sub


Code : Tout sélectionner
'*-
'* Ecrire les correspondances de champ
'*-
Private Sub EcrireChamps ( hfic As Integer, _
doctyp As NotesDocument, _
doctrt As NotesDocument,version As String,ListeVal List As String, tabimg() As String )
   
   On Error Goto FinAnormale
   Print #hfic%, "/FDF << /Fields [ "+Chr(10);
   
   Const AV$ = "<</V>> "
   
     '*-- Parcourir les champs à traiter
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim v As String
   Dim valchp As String
   Dim rtitem As Variant
   Dim plainText As String
   
   Dim ListeFormat List As String
   Dim FormatC As String
   
   'Récupération des formats spécifiques
   Forall f In doctyp.FormatP
      ListeFormat(Strleft(f,":"))=Strright(f,":")
   End Forall
   Dim b As Integer
   b=1
   For k=0 To Ubound(tabimg)
      If tabimg(k)<>"" Then
         Print #hfic%,"<< /T (Image"+Cstr(b)+") /APRef << /N <</F>> >> >>"
         b=b+1
      End If
   Next
   
   i%=0
   Forall e In ListeVal
      
               '* Si champ multi-valué, générer des retours lignes
      'valchp = ValPDF ( i )
      
      If Not Iselement(ListeFormat(Listtag(e))) Then
         FormatC="$$"
      Else
         FormatC=ListeFormat(Listtag(e))
      End If
      valchp=remplace(FormatC,"$$",e)
      valchp=AutreFormat(valchp,ListeVal)
      
      v$ = FiltreAcrobat$ ( valchp )
      'v$ = remplace(FiltreAcrobat$ ( valchp ),"€","\240")
      Print #hfic%, AV$ & v$ & MI$ & Listtag(e) & AP$;
      v$=""
      i% = i% + 1
   End Forall
   
   Print #hfic%, "] ";
   Exit Sub
FinAnormale:
   Print "Erreur " & Error$ & " (dans EcrireChamps : " & Erl() & ")"
   On Error Goto 0
End Sub


Code : Tout sélectionner
* Ecrire l'accès au fichier PDF et ID signature
'*-
Private Sub EcrireFin ( hfic As Integer )
   
   Print #hfic%, ">> " & Chr$ (13);
   Print #hfic%, ">> " & Chr$ (13);
   Print #hfic%, "endobj" & Chr$ (13);
   Print #hfic%, "trailer" & Chr$ (13);
   Print #hfic%, "<<" & Chr$ (13);
   Print #hfic%, "/Root 1 0 R " & Chr$ (13);
   Print #hfic%, ">>" & Chr$ (13);
   Print #hfic%, "%%EOF" & Chr$ (13);
End Sub
"Si tu ne réussis rien du premier coup, alors le saut en parachute n'est pas fait pour toi"
Avatar de l’utilisateur
gouff
Posteur habitué
Posteur habitué
 
Message(s) : 277
Inscrit(e) le : 11 Fév 2008 à 16:33
Localisation : Grenoble

Retour vers Divers