Microsoft Word Page Sources
Microsoft Word Page SourcesConsultez toutes les sources
Nombre d'auteurs : 5, nombre de sources : 7, création le 1er octobre 2007
Sommaire→Divers
Ces différentes procédures et fonctions vont vous venir en aide pour la gestion des variables de document.
Sélectionnez
'---------------------------------------------------------------------------------------
' Procédure : AddMyVar [Function]
' Retour : Boolean
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Ajouter une variable
' : Si la variable existe et bUpdateIfExists = true :
' : => Mise à jour de sa valeur
' Historique :
'---------------------------------------------------------------------------------------
Public Function AddMyVar(ByVal sNom As String, ByVal sText As String, _
Optional bUpdateIfExists As Boolean = True) As Boolean
On Error Resume Next
ActiveDocument.Variables.Add sNom, sText
If err = 5903 Then 'La variable existe déjà
If bUpdateIfExists Then
err.Clear
ActiveDocument.Variables(sNom).Value = sText
End If
End If
If err = 0 Then AddMyVar = True
End Function
'---------------------------------------------------------------------------------------
' Procédure : LetMyVar [Function]
' Retour : Boolean
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Mettre à jour une variable
' : Si la variable n'existe pas et bAddIfNotExists = True :
' : => Ajoute la variable
' Historique :
'---------------------------------------------------------------------------------------
Public Function LetMyVar(ByVal sNom As String, ByVal sText As String, _
Optional bAddIfNotExists As Boolean = True) As Boolean
On Error Resume Next
Dim lIdx As Long
lIdx = ActiveDocument.Variables(sNom).Index
If err = 0 Then
ActiveDocument.Variables(lIdx).Value = sText
ElseIf err = 5825 Then 'La variable n'existe pas
If bAddIfNotExists Then
err.Clear
ActiveDocument.Variables.Add sNom, sText
End If
End If
If err = 0 Then LetMyVar = True
End Function
'---------------------------------------------------------------------------------------
' Procédure : IsMyVar [Function]
' Retour : Boolean
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Vérifier si une variable existe ou non
' : Argument : Index ou Nom de la variable
' Historique :
'---------------------------------------------------------------------------------------
Public Function IsMyVar(ByVal vItem As Variant) As Boolean
On Error Resume Next
IsMyVar = (ActiveDocument.Variables(vItem).Index > 0)
If err = 5825 Then err.Clear 'La variable n'existe pas
End Function
'---------------------------------------------------------------------------------------
' Procédure : DelMyVar [Function]
' Retour : Boolean
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Supprime une variable par son nom ou son index
' Historique :
'---------------------------------------------------------------------------------------
Public Function DelMyVar(ByVal vItem As Variant) As Boolean
On Error Resume Next
ActiveDocument.Variables(vItem).Delete
If err = 0 Then
DelMyVar = True
Else
err.Clear
End If
End Function
'---------------------------------------------------------------------------------------
' Procédure : DelAllMyVars [Function]
' Retour : Boolean
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Supprimer toutes les variables
' Historique :
'---------------------------------------------------------------------------------------
Public Function DelAllMyVars() As Boolean
On Error GoTo errtag
While ActiveDocument.Variables.Count
ActiveDocument.Variables(1).Delete
Wend
DelAllMyVars = True
Exit Function
errtag:
MsgBox "L'erreur n°" & err & " est survenue...", vbExclamation, "DelAllMyVars()"
Resume Next
End Function
'---------------------------------------------------------------------------------------
' Procédure : GetValueMyVar [Function]
' Retour : String
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Récupérer le contenu de la variable par son nom ou son index
' : Si elle n'existe pas, retourne la valeur par défaut ou une chaine vide
' Historique :
'---------------------------------------------------------------------------------------
Private Function GetValueMyVar(ByVal vItem As Variant, _
Optional ByVal sDefaut As String) As String
On Error Resume Next
GetValueMyVar = ActiveDocument.Variables(vItem).Value
If err Then
If err = 5825 Then err.Clear
GetValueMyVar = sDefaut
End If
End Function
'---------------------------------------------------------------------------------------
' Procédure : GetIndexMyVar [Function]
' Retour : Long
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Récupérer l'index de la variable par son nom
' Historique :
'---------------------------------------------------------------------------------------
Public Function GetIndexMyVar(ByVal sNom As String) As Long
On Error Resume Next
GetIndexMyVar = ActiveDocument.Variables(sNom).Index
If err = 5825 Then err.Clear
End Function
'---------------------------------------------------------------------------------------
' Procédure : GetNomMyVar [Function]
' Retour : String
' Version : 1.0
' Création/Maj : Le samedi 12 janvier 2008
' Objet : Récupérer le nom de la variable par son index
' Historique :
'---------------------------------------------------------------------------------------
Public Function GetNomMyVar(ByVal lIndex As Long) As String
On Error Resume Next
GetNomMyVar = ActiveDocument.Variables(lIndex).Name
If err = 5825 Then err.Clear
End FunctionCréé le 12 janvier 2008 par philben
Ce bout de code permet de copier les propriétés personnelles d'un document à l'autre.
Les documents sources et cibles sont obtenus par l'ouverture d'une boîte de dialogue.
Sélectionnez
Sub copierProprietes()
'Déclaration des variables
' Boîte de dialogue ouverture de fichier
Dim oDlg As FileDialog
'Tableau liste des propriétés
Dim lstProp() As String
'Documents cible et source
Dim oDocSource As Document
Dim oDocCible As Document
'Entier pour l'adresse du tableau
Dim intP As Integer
'Affectation des valeurs aux variables
Set oDlg = Application.FileDialog(msoFileDialogFilePicker)
With oDlg
.Title = "Choisissez la source !"
.Show
End With
'Affectation de l'objet document avec le chemin de la source
'renvoyé par l'objet FileDialog
Set oDocSource = Documents.Open(FileName:=oDlg.SelectedItems(1))
With oDlg
.Title = "Choisissez la cible !"
.Show
End With
Set oDocCible = Documents.Open(FileName:=oDlg.SelectedItems(1))
'Test sur le nombre de propriétés trouvées
'Si pas de propriétés on continue le code à l'étiquette PasDeProp
If oDocSource.CustomDocumentProperties.Count = 0 Then GoTo PasDeProp
'dimentionnement du tableau en fonction du nombre de propriétés trouvées
ReDim lstProp(oDocSource.CustomDocumentProperties.Count, 2)
'Boucle sur les propriétés du document pour récupérer les données
For intP = 1 To oDocSource.CustomDocumentProperties.Count
lstProp(intP - 1, 1) = oDocSource.CustomDocumentProperties(intP).Name
Debug.Print oDocSource.CustomDocumentProperties(intP).Value & " -- " & lstProp(intP - 1, 1)
lstProp(intP - 1, 2) = oDocSource.CustomDocumentProperties(intP).Value
Next intP
'Écriture des propriétés dans le document cible
For intP = 0 To UBound(lstProp, 2)
oDocCible.CustomDocumentProperties.Add Name:=lstProp(intP, 1), LinkToContent:=False, Value:=lstProp(intP, 2), Type:=msoPropertyTypeString
Next intP
oDocCible.Save
Debug.Print oDocCible.CustomDocumentProperties.Count
PasDeProp:
'Fermeture et libération des objets.
Set oDlg = Nothing
oDocSource.Close
Set oDocSource = Nothing
oDocCible.Close
Set oDocCible = Nothing
End SubCréé le 26 décembre 2012 par Sepia