IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

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 

 
OuvrirSommaireDivers

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 Function
Créé 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 Sub
Créé le 26 décembre 2012  par Sepia

Page de l'auteur

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.