1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
| Dim wdApp As Object
' Fonction qui retourne une chaîne
Public Function GenerateDocument(sTags As String, sValues As String, SsourcePath As String, SdestPath As String) As String
On Error GoTo ErrHandler
Dim arrTags() As String, arrValues() As String, iLoop As Integer
Dim iPosition As Integer, iCheckError As Integer
iCheckError = 0
Set wdApp = CreateObject("Word.Application")
iCheckError = 1
'Ouvre le fichier modèle à partir du chemin spécifié (envoyé par le fichier ASP _
en tant que paramètre). Une référence au nouveau document Word, fondé sur le modèle, _
est créée sur le serveur :
wdApp.Documents.Open SsourcePath
'Récupération de toutes les valeurs obtenues à partir du fichier ASP, _
dans le tableau arrTags, en utilisant la fonction Split. La virgule sert de _
séparateur afin de séparer les valeurs de balise dans le fichier ASP :
arrTags = Split(sTags, ", ")
'Stocke les valeurs correspondant aux valeurs en entrée dans le tableau arrValues. _
Le caractère pipe (|) est utilisé comme séparateur
arrValues = Split(sValues, " | ")
'Traitement par itération des balises du tableau arrTags et utilisation _
de la fonction Rechercher/Remplacer (en utilisant un script VBA) pour trouver _
les balises du tableau, dans le document Word créé, en les remplaçant par les _
valeurs correspondantes du tableau arrValues. La série de virgule correspond à _
certains paramètres optionnels de la méthode Find.Execute qui n 'ont pas été _
définis. Nous ne nous intéressons ici qu'à la mise en uvre des options _
MatchWholeWord, ReplaceWith, et ReplaceAll (représentées ici par la constante _
numérique 2).
'Contournement d'un bug word : impossibilité de rechercher/remplacer des chaînes_
'de plus de 255 caractères
For iLoop = 0 To UBound(arrTags)
If Len(arrValues(iLoop)) < 255 Then
sTampon = arrValues(iLoop)
iPosition = InStr(sTampon, "ZZRetCharZZ")
If iPosition > 0 Then
wdApp.Selection.Find.ClearFormatting
With wdApp.Selection.Find
.Text = arrTags(iLoop)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdApp.Selection.Find.Execute
Do While iPosition > 0
wdApp.Selection.TypeText Text:=left(sTampon, iPosition - 1)
wdApp.Selection.TypeParagraph
sTampon = right(sTampon, Len(sTampon) - (iPosition + 10))
iPosition = InStr(sTampon, "ZZRetCharZZ")
Loop
'On affiche la dernière partie !
wdApp.Selection.TypeText Text:=sTampon
Else
wdApp.ActiveDocument.Content.Find.Execute arrTags(iLoop), , True, , _
, , , , , sTampon, 2
End If
Else
'Si la chaîne est plus longue
'If arrTags(iLoop) = "<phrase_4>" Or arrTags(iLoop) = "<nom_agent>" Then
sTampon = arrValues(iLoop)
iPosition = InStr(sTampon, "ZZRetCharZZ")
If iPosition > 0 Then
wdApp.Selection.Find.ClearFormatting
wdApp.Selection.Find.Text = arrTags(iLoop)
wdApp.Selection.Find.Execute
Do While iPosition > 0
wdApp.Selection.TypeText Text:=left(sTampon, iPosition - 1)
wdApp.Selection.TypeParagraph
sTampon = right(sTampon, Len(sTampon) - (iPosition + 10))
iPosition = InStr(sTampon, "ZZRetCharZZ")
Loop
'On affiche la dernière partie !
wdApp.Selection.TypeText Text:=sTampon
End If
'End If
End If
Next iLoop
'Enregistre le document à l'endroit spécifié
wdApp.ActiveDocument.SaveAs SdestPath
'Ferme le document, quitte et release
wdApp.ActiveDocument.Close
wdApp.Quit
Set wdApp = Nothing
'Retourne un flag success et quitte la fonction
GenerateDocument = "Success"
Exit Function
'Routine de gestion d'erreur. Retourne le message d'erreur,
'si une erreur s'est produite durant le processus.
ErrHandler:
If iCheckError = 0 Then
'Gestion des logs
Global_ErrorLog = "Erreur dans la génération du rapport : " & SdestPath
Global_ErrorLog = Global_ErrorLog & vbCrLf & "Impossible de charger le composant Word.Application"
Call SaveLogFile("DocumentObject", Global_ErrorLog, LOG_FILENAME, sModeDebug)
GenerateDocument = "Impossible de charger le composant Word.Application"
Exit Function
End If
'Quitte et libère le word document objet
wdApp.ActiveDocument.Close
wdApp.Quit
Set wdApp = Nothing
'Construction du message d'erreur et le retourne
Dim ErrMsg As String
ErrMsg = "Error Number: " & Err.Number & Chr(10) & "Error Source: " & Err.Source & Chr(10)
ErrMsg = ErrMsg & "Error Description: " & Err.Description & Chr(10)
GenerateDocument = ErrMsg
'Gestion des logs
Global_ErrorLog = "Erreur dans la génération du rapport : " & SdestPath
Global_ErrorLog = Global_ErrorLog & vbCrLf & ErrMsg
Global_ErrorLog = Global_ErrorLog & vbCrLf & "sTags = " & sTags
Global_ErrorLog = Global_ErrorLog & vbCrLf & "sValues = " & sValues
Call SaveLogFile("DocumentObject", Global_ErrorLog, LOG_FILENAME, sModeDebug)
Exit Function
End Function |
Partager