Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!
Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:
Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issues
d'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'en
priver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _
"Impossible de réaffecter les commandes de
cette." & _
"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)
End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
les
boutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add
_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menu
puis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
fait
bien apparaître, dans la fenêtre Exécution, les menus contextuels que j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
que
j'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!
Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:usxkSQggEHA.3916@TK2MSFTNGP11.phx.gbl...
Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issues
d'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'en
priver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _
"Impossible de réaffecter les commandes de
cette." & _
"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)
End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de
news:%23%23ddH9cgEHA.216@tk2msftngp13.phx.gbl...
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
les
boutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add
_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menu
puis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
fait
bien apparaître, dans la fenêtre Exécution, les menus contextuels que j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OWed62bgEHA.1276@TK2MSFTNGP09.phx.gbl...
Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de news:eTkQSwXgEHA.384@TK2MSFTNGP10.phx.gbl...
bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle bogue
sur
If C.OnAction.....propriété ou méthode non gérée par cet objet..alors
que
j'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avait
vendue, pas vraiment puisqu'il s'était contenté de me dire qu'il fallait
que
je pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortire
ex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!
Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:
Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issues
d'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'en
priver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _
"Impossible de réaffecter les commandes de
cette." & _
"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)
End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
les
boutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add
_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menu
puis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
fait
bien apparaître, dans la fenêtre Exécution, les menus contextuels que j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
que
j'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:OTUQ%
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" a écrit dans le message de
news:eZZ%Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issuesd'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'enpriver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _"Impossible de réaffecter les commandes de
cette." & _"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message denews:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
lesboutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menupuis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
faitbien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
quej'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de
news:OTUQ%23KhgEHA.3348@TK2MSFTNGP12.phx.gbl...
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:eZZ%23RhggEHA.3016@tk2msftngp13.phx.gbl...
Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!
Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:usxkSQggEHA.3916@TK2MSFTNGP11.phx.gbl...
Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issues
d'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'en
priver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _
"Impossible de réaffecter les commandes de
cette." & _
"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)
End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de
news:%23%23ddH9cgEHA.216@tk2msftngp13.phx.gbl...
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
les
boutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add
_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menu
puis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
fait
bien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OWed62bgEHA.1276@TK2MSFTNGP09.phx.gbl...
Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de news:eTkQSwXgEHA.384@TK2MSFTNGP10.phx.gbl...
bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
sur
If C.OnAction.....propriété ou méthode non gérée par cet objet..alors
que
j'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avait
vendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
que
je pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortire
ex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:OTUQ%
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" a écrit dans le message de
news:eZZ%Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issuesd'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'enpriver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _"Impossible de réaffecter les commandes de
cette." & _"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message denews:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
lesboutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menupuis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
faitbien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
quej'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:OTUQ%
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" a écrit dans le message de
news:eZZ%Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issuesd'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'enpriver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _"Impossible de réaffecter les commandes de
cette." & _"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message denews:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
lesboutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menupuis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
faitbien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
quej'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de
news:OTUQ%23KhgEHA.3348@TK2MSFTNGP12.phx.gbl...
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:eZZ%23RhggEHA.3016@tk2msftngp13.phx.gbl...
Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!
Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:usxkSQggEHA.3916@TK2MSFTNGP11.phx.gbl...
Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issues
d'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'en
priver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _
"Impossible de réaffecter les commandes de
cette." & _
"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)
End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de
news:%23%23ddH9cgEHA.216@tk2msftngp13.phx.gbl...
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
les
boutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add
_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menu
puis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
fait
bien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OWed62bgEHA.1276@TK2MSFTNGP09.phx.gbl...
Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le
message de news:eTkQSwXgEHA.384@TK2MSFTNGP10.phx.gbl...
bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
sur
If C.OnAction.....propriété ou méthode non gérée par cet objet..alors
que
j'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avait
vendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
que
je pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortire
ex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
Bonjour JPS,
Les barres d'outils sont formées de 2 éléments :
A ) La barre elle-même que ce soit une barre contextuelle ou une barre
fixe, qu'elle soit "Built-In" ou "Personnalisé"
B ) les contrôles qui habillent la barre ... il y en a de divers types
.... mais ce qui nous intéresse dans ta problématique,
ce sont les contrôles qui ont une propriété "OnAction" à partir de
laquelle il est possible d'associer une action (Macro) sur
simple clic de ces derniers.
C ) Lorsque l'on crée manuellement à partir de l'application Excel des
nouveaux contrôles sur une barre d'outils déjà
existante ou sur une barre d'outils personnalisée, on doit définir la
propriété "OnAction", en associant au bouton de la
barre d'outils une macro.
À ce moment là , la propriété OnAction a cette apparence :
'C:ExcelBouton_JPS1.xls'!toto
'C:ExcelBouton_JPS1.xls'! = Chemin et nom du fichier
toto = Nom de la macro contenu dans le fichier.
La propriété OnAction ainsi définit recherchera toujours la macro dans le
classeur spécifié lors d'un clic. En conséquence,
si on modifie le nom du fichier ou l'emplacement du fichier dans
l'arborescence des répertoires, le bouton de la barre
d'outils ne pourra retrouver et exécuter la macro définit par sa propriété
"OnAction".
La macro qui suit, couvre tous les contrôles sans égard à leur type, et
regarde seulement ceux qui ont une propriété
"OnAction" et parmi ces derniers seulement ceux dont la propriété est déjà
définie. (donc une macro leur a déjà été associée)
Cette macro identifie cette section 'C:ExcelBouton_JPS1.xls'! de la
propriété "OnAction" de chacun des boutons, le cas
échéant, et le remplace par le nouveau chemin et nouveau nom du fichier
( Nouveau = "'" & ThisWorkbook.FullName & "'!" )
En principe, cela devrait bien se dérouler, sauf, si tu as défini leur
propriété "OnAction" avec des macros situés dans le
classeur Perso.xls. La substitution qu'il fera à ce moment là, sera
erronée... car dans ce cas, elle n'a pas besoin d'être
modifiée sauf si on a changé d'ordinateur et que l'on se retrouve avec un
nouveau système d'opération. Le perso.xls que l'on
a pris la peine de copier ne se retrouve pas nécessairement dans le même
répertoire et son chemin n'est pas nécessairement le
même d'ailleurs.
La macro qui suit est une dérivée de la toute première ...tes macros
doivent être toutes situées dans le classeur. La macro
précédente était plus longue à exécuter parce qu'elle prenait le temps de
rechercher sur le C: l'emplacement de ton perso.xls
pour pouvoir discriminer la provenance des macros (fichier actuel ou
perso) et apporter la modification qui s'impose.
Pour ce qui est de tes explications, j'ai un peu de misère à suivre .. .
tu sembles vouloir insérer un menu contextuel dans
la Worksheet Menu Bar !!! Je n'ai pas nécessairement la même définition
d'un menu contextuel.
Et pour terminer, Est-ce que tes contrôles sont créés par programmation ou
manuellement ? Dans la première éventualité,
serait-il possible de modifier le code tout simplement ?
Je le répète... ces procédures restent à tester ...
'----------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
Else
Err = 0
End If
Next
Next
End Sub
'----------------------------------
Salutations!
"sabatier" a écrit dans le
message de
news:OTUQ%
aie aie aie, denis....
j'ai testé moi et me suis retrouvé avec tous mes chemins de bouton
"ancienne
vague" alors quavec ta première proc, je les avais bien remis dans le bon
sens de l'histoire....
et puis, j'ai dû stopper la proc car elle ne semblait plus vouloir finir
mais elle avait déjà causé les quelques petits malheurs ci-dessus...
tu sais, denis, ce que je souhaiterais c'est que, dans le style très
fluide
de ta première proc, on puisse traiter aussi ces boutons que tu crées en
montant en un premier temps dans la Worksheet Menu Bar le bouton Nouveau
Menu de la boîte Outils/Personnaliser puis en installant dans le menu
contextuel qui se déroule sous Nouveau Menu (comme se déroule Nouveau,
Ouvrir, Fermer etc... sous Fichier) les mêmes boutons que ceux qu'on
installe directement dans une BO ; je suppose que dans le cas du menu
contextuel, ces boutons ne s'appellent pas comme les autres....
m'as-tu compris? j'espère car tu m'as trop fait peur avec ta proc qui
pourtant avait fière allure : on aurait dit la petite japonaise sur le
tatami de sa médaille d'or....
allez, retravaille un peu denis, tu me sembles un peu décontract' sur ce
coup!!!!
jps
"michdenis" a écrit dans le message de
news:eZZ%Attention, il faut enlever à la procédure soumise dans le message
précédent la ligne de code suivante :
If Ctl.Caption = "&Bouton personnalisé" Then Stop
Elle n'était là que pour un petit test perso. J'ai omis de l'enlever
...elle n'a plus aucune utilité !!!Sa présence arrêtera l'exécution de la macro le cas échéant et ce n'est
sûrement pas désirable.
Salutations!
"michdenis" a écrit dans le message de
news:Bonjour JPS,
" Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add ... "
Est-ce que cette barre d'outils est issue du même classeur ou provient
de
ton fichier "Perso.xls".
Je te propose une macro qui devrait traiter tous les contrôles de toutes
les barres d'outils sauf si certaines sont issuesd'un fichier .xla . Évidemment, je n'ai pas testé la macro... j'ai un
cobaye professionnel sur les BO... je ne vais pas m'enpriver ...!
Les précautions d'usage s'applique !!!
'--------------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer, MonPerso As String
Dim Ctl As Object
With Application.FileSearch
.NewSearch
.LookIn = "c:"
.SearchSubFolders = True
.Filename = "Perso.xls"
If .Execute > 0 Then
MonPerso = "'" & .FoundFiles(1) & "'!"
End If
End With
On Error Resume Next
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Err = 0 Then
If Ctl.Caption = "&Bouton personnalisé" Then Stop
If Ancien <> "" Then
If InStr(1, Ancien, "Perso.xls", vbTextCompare) > 0 Then
If MonPerso = "" Then
MsgBox "Le fichier Perso.xls est manquant." &
vbCrLf & _"Impossible de réaffecter les commandes de
cette." & _"barre d'outils : " & CommandBars(A).Name
Else
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
MonPerso)End If
ElseIf InStr(1, Ancien, "xla", vbTextCompare) = 0 Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien,
Nouveau)
End If
End If
Else
Err = 0
End If
Next
Next
End Sub
'--------------------------------------------
Salutations!
"sabatier" a écrit dans le
message denews:%23%
bonjour denis et bon réveil
enfin, pas si bon que cela puisque je vais te demander de me rendre une
partie au moins de mon argent puisque ma satisfaction n'a pas été
garantie
100 %....
je plaisante bien sûr puisque ta proc a marché du feu de Dieu pour tous
lesboutons des BO sauf pour les suivants :
Application.CommandBars("Menu contextuel personnalisé
2831375").Controls.Add_
Type:=msoControlButton, Id:)50, Before:=1
j'ai bien essayé de changer le "type = 1" (c'est quoi ce Type que je
n'ai
retrouvé nulle part dans l'aide?) mais oualou de chez oualaou, zont pas
bronché d'un eta d'epsilon mes petits boutons que j'ai mis avec Nouveau
Menupuis déferlante de popups....dans la Worksheet Menu Bar....
question : que faut-il ajouter à ta proc pour qu'elle prenne en charge
les
boutons de ce type?
tu me diras que je peux tous leur réaffecter la macro mais c'est là
qu'ils
sont le plus nombreux, ces petits salopards...
merci pour ta nouvelle étude
merci aussi à toi, michel G pour ta réponse : ta proc avec Debug Print
faitbien apparaître, dans la fenêtre Exécution, les menus contextuels que
j'ai
ajouté à la barre 1 et dont denis va se faire un plaisir à me changer le
chemin d'accès qui, suite à une mauvaise manip' est passé chez
l'ennemi....
à +
jps
"michdenis" a écrit dans le message de
news:Bonjour JPS,
Essaie ceci ,
Satisfaction garantie ou Argent remis !
Au fait, c'est quoi le tarif ici quand on n'est pas MVP ?
;-))
'Prudence lors de tes tests ....!
'Rien d'autre à faire que de copier la procécure dans
' un module de ton classeur et de l'exécuter
'------------------------------------
Sub Mise_A_Jour_Mes_Boutons()
Dim Ancien As String, Nouveau As String
Dim A As Integer
Nouveau = "'" & ThisWorkbook.FullName & "'!"
For A = 1 To Application.CommandBars.Count
For Each Ctl In CommandBars(A).Controls
If Ctl.Type = 1 Then
Ancien = Left(Ctl.OnAction, InStrRev(Ctl.OnAction, "!"))
If Ancien <> "" Then
Ctl.OnAction = Replace(Ctl.OnAction, Ancien, Nouveau)
End If
End If
Next
Next
End Sub
'------------------------------------
Salutations!
"sabatier" a écrit dans le
message de news:bonjour(c)
pourquoi, mes chers frères, cette proc ne veut pas marcher ; elle
bogue
surIf C.OnAction.....propriété ou méthode non gérée par cet objet..alors
quej'ai souvenance qu'elle fonctionnait lorsque le père brossollette me
m'avaitvendue, pas vraiment puisqu'il s'était contenté de me dire qu'il
fallait
queje pense à ses bonnes oeuvres....
voici donc l'objet du délit et je vous avoue que "mihi placerit bene
sortireex illo cacato"
Sub RecupererCheminsDesBoutons()
mauvais = "C:Sauvegarde Automatique"
bon = "C:Documents and Settingsjean-paulApplication
DataMicrosoftExcelXLSTART"
With Application.CommandBars(1)
For Each C In .Controls
If C.OnAction Like "*C:Sauvegarde Automatique*" Then _
C.OnAction = Application.Substitute(C.OnAction, mauvais, bon)
Next
End With
End Sub
gratia pro Deo
jps
