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
|
Dim ob As Visio.Shape ' variable objet
Dim obs As Visio.Shapes ' variable objets
Dim EX As Object ' déclaration objets Excel
Dim i, j As Integer ' compteurs
Dim n(5) As String ' tableaux de valeurs
Dim cel ' définition de la cellule Excel
' ch est le chemin complet, ou se trouve le fichier Excel
Set EX = GetObject(ch) ' déclaration objets Excel
Set obs = ThisDocument.Application.ActivePage.Shapes
' déclaration de toutes les formes
For Each ob In obs ' parcours des objets
If InStr(ob.Name, "Dessin1") Then ' sélection du nom de la forme
n(1) = ob.Cells("Prop.TITRE").ResultStr(Visio.visNone) ' on récupère les valeurs dans un tableau
n(2) = ob.Cells("Prop.TITLE").ResultStr(Visio.visNone)
n(3) = ob.Cells("Prop.NUMERO").ResultStr(Visio.visNone)
n(4) = ob.Cells("Prop.DESS1").ResultStr(Visio.visNone)
n(5) = ob.Cells("Prop.DAT1").ResultStr(Visio.visNone) End If ' fin de si
Next ' suivant
EX.Application.Visible = False ' met les document Excel invisible
EX.Parent.Windows(1).Visible = True
EX.Worksheets(Feuil1).Activate ' active la première feuille
EX.Worksheets(Feuil1).Range("B2") = "Titre" ' ajout des informations sur la feuille
EX.Worksheets(Feuil1).Range("B3") = "Title"
EX.Worksheets(Feuil1).Range("B4") = "Numéro"
EX.Worksheets(Feuil1).Range("B5") = "Créateur"
EX.Worksheets(Feuil1).Range("B6") = "Date Création"
Set cel = EX.Worksheets(F1).Range("C2") ' sélection de la feuille 1 cellule C2
For j = 1 To 5 ' faire 5 fois
cel.Offset(j - 1, 0) = n(j) ' prochaine cellule reçoit valeur
Next ' suivant
EX.Save ' sauvegarde du document
EX.Application.Quit ' fermeture du document |
Partager