Discussion :

[milouse95620]

Bonjour,
J'essaye de créer une macro pour faire un rechercher remplacer de lien hypertexte.
J'arrive à le faire en sélectionnant une feuille mais si je veux l'appliquer à l'ensemble cela ne marche pas

Ci-dessous mon code

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
  Dim Cellule As Object , oTextfields As Object 
 
  Dim iCount As Integer, iCount2 As Integer, isheet As Integer
  Dim searchhyper, remplacehyper, search, remplace
 
 'calcule du nombre de feuille
 sheetscount = ThisComponent.Sheets
 
 'récupération du répertoire source 
 search = InputBox("Indiquez le texte à rechercher", "RECHERCHER REMPLACER LIEN HYPERTEXTE", "")
 'conversion pour le lien du répertoire
 searchhyper = replace(search,"\","/")
 
'récupération du répertoire de destination 
 remplace = InputBox("Indiquez le texte remplacer", "RECHERCHER REMPLACER LIEN HYPERTEXTE", "")
 'conversion pour le lien de destinataion
 remplacehyper = replace(remplace,"\","/")
 
 
 sheets = ThisComponent.Sheets
 
 'parcourir les feuilles
 For isheet= 0 to sheets.count-1
 
	Print isheet
 
	For iCount = 0 To 1000
                 For iCount2 = 0 To 1000  
 
    	' Sélection de la celulle
  			Cellule = ThisComponent.Sheets(isheet).GetCellByPosition(iCount,iCount2) 
 
  			oTextfields = Cellule.TextFields  
 
  			'Vérifie s'il y a des liens dans la cellule 
  			If oTextfields.Count = 0 Then 
 
 	 		Else
 	 			'remplacement du texte et du lien
				oTextFields(0).URL = replace(oTextFields(0).URL,searchhyper,remplacehyper)
  				oTextFields(0).Representation = replace(oTextFields(0).Representation,search,remplace)
			End If 
 
  		Next iCount2
    Next iCount
 
Next  isheet

Je sais il y a pas mal de chose à revoir comme je n'ai pas trouvé comment récupérer le dernière et colonne utilise comme Ctrl Fin.

mon problème vient surtout dans les boucles. Si je supprime, pas de problème , on boucle autant de fois qu'il y a de feuille.
SI j’enlève la première boucle for pour la parcours des feuille, j'indique la feuille que je veux et ca fonctionne.

Dans l'état actuel de mon code si je le lance, ça fonctionne que sur le première feuille. La première boucle for pour la gestion des sélections des feuilles passe mais ne boucle pas autant de fois qu'il y a de feuille.
J'ai l'impression que c'est:

Code :

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

Cellule = ThisComponent.Sheets(isheet).GetCellByPosition(iCount,iCount2)

qu'il n'aime pas.



Pouvez-vous m'aider à résoudre le problème.

Merci d'avance,
Damien

[milouse95620]

Bon le tableau de rechercher 1000 * 1000 , ca fait beaucoup .
J'ai réduis et ça tourne plus vitre, y a pas photo.
Pouvez-vous me dire comme récupérer la dernière cellule utilisé comme Ctrl Fin.
Merci.

[Mobydick_62]

Bonjour

Pouvez-vous me dire comme récupérer la dernière cellule utilisé

Voici deux exemple à adapter :

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 main
 Dim pCell As Long 
 pCell = DerCellUtilisee
 Print pCell
End Sub 
 
'Retourne la dernière cellule utilisée d'une zone précise
Function DerCellUtilisee()
 Dim oFeuille As Object, oCellule As Object, oZone As Object
 Dim zoneVide As Variant
 oFeuille = ThisComponent.getSheets.getByName("Feuille1")
 oZone = oFeuille.getCellRangeByName("A1:B40")
 zoneVide = oZone.queryEmptyCells.RangeAddresses
 DerCellUtilisee = zoneVide(0).StartRow
End Function

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub main2
 Dim pCell As Long 
 pCell = NbreEnregistrement("Feuille1")
 Print pCell
End Sub 
 
'___________________________________________________________________________________
'Retourne la dernière ligne remplie sur la feuille passée en paramètre 
Function NbreEnregistrement (sFeuille As String) As Long
 Dim oCurseur As Object
 oCurseur = ThisComponent.getSheets.getByName(sFeuille).createCursor
 oCurseur.gotoEndOfUsedArea( False )
 NbreEnregistrement =  oCurseur.RangeAddress.EndRow+1
End Function

Cordialement

[milouse95620]

Merci pou votre aide, le code n'est pas magnifique mais fait son djob.

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
 Dim Cellule As Object , oTextfields As Object 
 
  Dim Feuille As Object, Curseur As Object 
  Dim Cible As Object 
 
  Dim iCount As Integer, iCount2 As Integer, isheet As Integer, ligneend As Integer, colonneend As Integer
  Dim searchhyper, remplacehyper, search, remplace
 
 'calcule du nombre de feuille
 sheetscount = ThisComponent.Sheets
 
 'récupération du répertoire source 
 search = InputBox("Indiquez le texte à rechercher", "RECHERCHER REMPLACER LIEN HYPERTEXTE", "")
 'conversion pour le lien du répertoire
 searchhyper = replace(search,"\","/")
 
'récupération du répertoire de destination 
 remplace = InputBox("Indiquez le texte remplacer", "RECHERCHER REMPLACER LIEN HYPERTEXTE", "")
 'conversion pour le lien de destinataion
 remplacehyper = replace(remplace,"\","/")
 
 'sélection du classeur
 sheets = ThisComponent.Sheets
 
 
 
 'parcourir les feuilles - sheets.count indique le nombre de feuilles
 For isheet= 0 to sheets.count-1
 
 
  'Sélection de la feuille  
  Feuille = ThisComponent.Sheets.getByIndex(isheet)  
 
  'récupération de la dernière ligne et colonne  
  Curseur = Feuille.createCursor() 
 
   Curseur.gotoStartOfUsedArea(False)  
   Curseur.gotoEndOfUsedArea(True)  
   Cible = Curseur.getRangeAddress()  
 
 
 
 
	For iCount = 0 To Cible.EndColumn
        For iCount2 = 0 To Cible.EndRow
 
    	' Sélection de la celulle
  			Cellule = ThisComponent.Sheets(isheet).GetCellByPosition(iCount,iCount2) 
 
 
 
  			oTextfields = Cellule.TextFields  
 
  			'Vérifie s'il y a des liens dans la cellule 
  			If oTextfields.Count = 0 Then 
 
 	 		Else
 	 			'remplacement du texte et du lien
				oTextFields(0).URL = replace(oTextFields(0).URL,searchhyper,remplacehyper)
  				oTextFields(0).Representation = replace(oTextFields(0).Representation,search,remplace)
			End If 
 
  		Next iCount2
    Next iCount
 
Next  isheet
 
Print "fin"

Il me reste plus qu'a trouver comment l'exporter et l'importer facilement sur des postes dont les personnes en ont besoins.