macro copie d'un fichier à un autre en conservant annotations

**mnssylvain** · 27/05/2015, 11h16

Bonjour à tous,

J'ai un soucis dans Calc.
Dans l'optique d'une mise à jour d'un fichier Calc, je cherche à faire une macro qui copie une zone de la feuille d'un fichier source pour la coller dans un fichier de destination.

On (je suis pas seul sur le coup....) a réussi à faire la macro qui copie colle mais on a remarqué que les commentaires ou annotations des cellules eux n'étaient pas copiés.

Pour tester j'ai fait une macro qui copie colle dans le même fichier et là l'annotation est conservée. Le problème à l'air de se poser que lorsqu'on change de fichier.
Je ne sais pas du tout comment sont gérées les annotations et j'ai pas réussi à trouver beaucoup d'info sur google.

Voici le code qu'on utilise pour le moment, il ne doit pas être très propre car on a essayer de compiler divers code que l'on a trouvé sur le net.....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
REM  *****  BASIC  *****
 
Sub ouvrirfichiercopiercellule
MsgBox("ATTENTION: lancement de l'importation des données d'un autre classeur")
MsgBox("Toujours faire une copie de sauvegarde (et la conserver) auparavant")
MsgBox("En cas de doute, abandonner la procédure et contacter votre ER-TICE")
Dim DocumentEnCours as object, FeuillesDocumentEnCours as object, MaFeuilleDocumentEnCours as object
Dim RepertoireURLNonConverti As object ,  ValeurRepertoireURLNonConverti As Integer , RepertoireURLConverti as string, oCurseurMaFeuilleDocumentEnCours as object, oCurseur2MaFeuilleDocumentEnCours as object
Dim ListeFichiersRepertoire As string , Resultat As String
Dim AdresseFichier as string
 
 
 
Dim ChoixFichiers As Object, LesFichiers As Object
Dim MonFic As string, Fic()As String, LeRep As String 
 
   ChoixFichiers = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
   ChoixFichiers.DisplayDirectory = ConvertToURL("C:\Mes Documents\")'adapter le chemin
   ChoixFichiers.appendFilter("Document ODF", "*.ods")';*.odt;*.odg;*.odp")'filtre les fichiers ODF
'   ChoixFichiers.appendFilter("Texte" , "*.txt")'filtre les fichiers texte
      If ChoixFichiers.execute = com.sun.star.ui.dialogs.ExecutableDialogResults.OK then
             LesFichiers = ChoixFichiers.Files
             MonFic = dir((LesFichiers(0))
 
             'MsgBox(ChoixFichiers.DisplayDirectory,0,"Le Répertoire")
             'MsgBox(LesFichiers(0),0,"Le Chemin")
             'MsgBox(MonFic,0,"Le fichier")
          End if
 
' a voir
Dim origDocument as object
Dim destDocument as object
Dim origDispatcher as object
Dim destDispatcher as Object
'pour les tableaux
Dim args(0) as new com.sun.star.beans.PropertyValue
Args(0).name="Hidden"
Args(0).value=true 
Dim props(0) as new com.sun.star.beans.PropertyValue
Dim Array(5) as new com.sun.star.beans.PropertyValue
Array(0).Name = "Flags"
Array(0).Value = "S" Rem S= String V= Value D= Date
Array(1).Name = "FormulaCommand"
Array(1).Value = 0
Array(2).Name = "SkipEmptyCells"
Array(2).Value = false
Array(3).Name = "Transpose"
Array(3).Value = false
Array(4).Name = "AsLink"
Array(4).Value = false
Array(5).Name = "MoveMode"
Array(5).Value = 0
 
 
dim args3(6) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Flags"
args3(0).Value = "SV"
args3(1).Name = "FormulaCommand"
args3(1).Value = 0
args3(2).Name = "SkipEmptyCells"
args3(2).Value = false
args3(3).Name = "Transpose"
args3(3).Value = false
args3(4).Name = "AsLink"
args3(4).Value = false
args3(5).Name = "MoveMode"
args3(5).Value = 4
args3(6).Name = "Annotation"
args3(6).Value = 1
 
 
DocumentEnCours = ThisComponent 'Sélectionne le document en cours
FeuillesDocumentEnCours=DocumentEnCours.sheets ' les feuilles du classeur
' destination
destDocument   = ThisComponent.CurrentController.Frame
destDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
 
 
 
AdresseFichier=(LesFichiers(0))
	    oDesktop = createUnoService( "com.sun.star.frame.Desktop" )
	    cURL = ConvertToURL( AdresseFichier )
   		oDoc = oDesktop.loadComponentFromURL(cURL , "_Blank", 0, args() )
	    origDocument = oDoc.CurrentController.Frame
 
 
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Ecoles	    	
'MaFeuilleDocumentEnCours = FeuillesDocumentEnCours.GetByName("Ecoles")
 
'oCurseurMaFeuilleDocumentEnCours = MaFeuilleDocumentEnCours.createCursor ' création du curseur
 
	    'MaFeuilleDocumentEnCours.getCellByPosition(21,((10-1+(X*20)))).string = AdresseFichier ' on écrit en B5 feuille1 (0,X) ou x = 1 au départ puis 2 3 4 5 .....
	    'MaFeuilleDocumentEnCours.getCellByPosition(4,(x+8)).string = DDE("soffice";(RepertoireURLConverti+"\"+ListeFichiersRepertoire);FICHE_ECOLE_A_remplir.B8)
	    'MaFeuilleDocumentEnCours.getCellByPosition(20,((10-1+(X*20)))).string = ListeFichiersRepertoire 
 
 
	    ' copie des infos "Ecoles" partie 1-------------------
 		MsgBox("Copie de Ecoles partie1")
 
	    	' à l'origine pas avant mais ça origDocument   = ThisComponent.CurrentController.Frame
			origDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			props(0).Name = "ToPoint"
			props(0).Value = "Ecoles.$A4:$D57"
 
 
			origDispatcher.executeDispatch(origDocument, ".uno:GoToCell", "", 0, props())
			origDispatcher.executeDispatch(origDocument, ".uno:Copy", "", 0, Array())
 
			props(0).Name = "ToPoint"
			props(0).Value = "Ecoles.$A4:$D57"
 
			destDispatcher.executeDispatch(destDocument, ".uno:GoToCell", "", 0, props())
			destDispatcher.executeDispatch(destDocument, ".uno:InsertContents", "", 0, args3())
 
	    ' copie des infos "Ecoles" partie 2-------------------
 
 		MsgBox("Copie de Ecole partie2")	    	
	    	' à l'origine pas avant mais ça origDocument   = ThisComponent.CurrentController.Frame
			origDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			props(0).Name = "ToPoint"
			props(0).Value = "Ecoles.$J4:$AC57"
 
 
			origDispatcher.executeDispatch(origDocument, ".uno:GoToCell", "", 0, props())
			origDispatcher.executeDispatch(origDocument, ".uno:Copy", "", 0, Array())
 
			props(0).Name = "ToPoint"
			props(0).Value = "Ecoles.$J4:$AC57"
 
			destDispatcher.executeDispatch(destDocument, ".uno:GoToCell", "", 0, props())
			destDispatcher.executeDispatch(destDocument, ".uno:InsertContents", "", 0, args3())
 
 
 
 
	    '- copie des infos par ITR-------------------
 
 
	    	MsgBox("Copie de ITR ")
			origDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			props(0).Name = "ToPoint"
			props(0).Value = "ITR.$B3:$E48"
 
 
			origDispatcher.executeDispatch(origDocument, ".uno:GoToCell", "", 0, props())
			origDispatcher.executeDispatch(origDocument, ".uno:Copy", "", 0, Array())
 
			props(0).Name = "ToPoint"
			props(0).Value = "ITR.$B3:$E48"
 
			destDispatcher.executeDispatch(destDocument, ".uno:GoToCell", "", 0, props())
			destDispatcher.executeDispatch(destDocument, ".uno:InsertContents", "", 0, args3())
 
 
	    '- copie de septembre-------------------
 
 
	    	MsgBox("Copie de septembre ")
			origDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			props(0).Name = "ToPoint"
			props(0).Value = "sep.$D5:$BA37"
 
 
			origDispatcher.executeDispatch(origDocument, ".uno:GoToCell", "", 0, props())
			origDispatcher.executeDispatch(origDocument, ".uno:Copy", "", 0, Array())
 
			props(0).Name = "ToPoint"
			props(0).Value = "sep.$D5:$BA37"
 
			destDispatcher.executeDispatch(destDocument, ".uno:GoToCell", "", 0, props())
			destDispatcher.executeDispatch(destDocument, ".uno:InsertContents", "", 0, args3())
 
 
 
End Sub

L'un d'entre vous aurez une piste?

Merci d'avance pour vos idées.....

**zoom61** · 27/05/2015, 13h24

Bonjour,

La solution va être de passer par une lecture de la cellule, et ensuite de rajouter cette annotation dans la copie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub VoirlaNote()
    Dim monDocument As Object, lesFeuilles As Object, maFeuille As Object
    Dim maCellule As Object, laNote As Object
 
    monDocument = ThisComponent
    lesFeuilles = monDocument.Sheets
    maFeuille = lesFeuilles.getByName("Feuille3")
    maCellule = maFeuille.getCellRangeByName("D57")
    laNote = maCellule.Annotation
    MsgBox("Auteur de la note : " & laNote.Author & cr & _
        "Date : " & laNote.Date & cr & _
        "Visible : " & laNote.IsVisible & cr & _
        "Note : " & cr & laNote.String, 0, _
        "Cellule : " & laNote.Parent.AbsoluteName)
End Sub

**mnssylvain** · 27/05/2015, 22h09

Bonsoir,

Merci pour cette réponse.
Si je comprend bien il va falloir que je copie/colle cellule par cellule, je ne peux pas faire une zone style B3:Z50 avec cette méthode si ?
Bon on doit pouvoir s'en sortir avec un système de boucle pour passer les x cellules de chaque colonne mais ça va faire un peux usine à gaz au final.....

**jurassic pork** · 28/05/2015, 02h18

hello,
tu peux essayer d'utiliser les fonctions getTransferable et insertTransferable qui m'ont l'air de tout copier.

Voici un exemple d'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub CopierCollerToutEntreClasseurs
 'J.P  Mai 2015
 Dim o
 Dim oFeuille
 Dim oPlage
 Dim Fichier
 Dim oDoc1,oDoc2
 Dim Args()
  ' on sélectionne le document courant
  oDoc1 = ThisComponent
  'on sélectionne la plage à copier
  oPlage = oDoc1.Sheets(0).getCellRangeByName("A1:B5")
  oDoc1.CurrentController.select(oPlage)
  o = oDoc1.CurrentController.getTransferable()
  ' on ouvre le deuxième document
  Fichier = ConvertToUrl("F:\temp\classeur2.ods") 
  oDoc2 = StarDesktop.loadComponentFromURL(Fichier,"_blank",0 ,Args() ) 
  'on sélectionne l'endroit où l'on va coller la plage copiée
  oPlage = oDoc2.Sheets(0).getCellRangeByName("C1")
  oDoc2.CurrentController.select(oPlage)
  oDoc2.CurrentController.insertTransferable(o)
End Sub

Ami calmant, J.P

**mnssylvain** · 01/06/2015, 01h49

Bonsoir,

Super ça a l'air de fonctionner......
Merci beaucoup !!!

macro copie d'un fichier à un autre en conservant annotations [OpenOffice][Tableur]

OpenOffice & LibreOffice

Discussions similaires

Partager

Partager