Mettre à jour une macro en fonction du nom du classeur

Bonjour,

Il faut paramétrer les macros avec:

x=ActiveWorkbook.Name ' nom du classeur actif

Pour ne pas mettre en dur les noms desrépertoires dans les macros.
Programmer par rapport au répertoire de l'application. Ainsi les appli
sont transportables dans tout répertoire.

Chdir ActiveWorkBook.Path ' positionne dans le répertoire de l'appli


Cordialement JB

Bonjour,

Il faut utiliser ActiveWorkBook.Name qui donne le nom du classeur
Actif.
Il ne faut pas mettre en dur les chemins:
Chdir ActiveWorkBook.Path pour se placer dans le rep de l'appli.

Cordialement JB

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

[bouton][menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

bonjours,
Les macros sont accrochés sur des [bouton]
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

Slt,

Voilà ce que ça donne sur des boutons, les macros affectent le classeur actif.
Ce module est enregistrer dans un classeur nommer en xla "Astuces.xla".
Tel que préciser, les fonctions de création et de supression de la barre
d'outils
sont appellées par les évènements d'ouverture/fermeture du classeur.

Option Explicit

Sub TestXLA()
If Not (ActiveWorkbook Is Nothing) Then
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil1").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil1").Select
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Sub Test()
If Not (ActiveWorkbook Is Nothing) Then
DoEvents
MsgBox "En cours !"
DoEvents
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Function AjoutMaBarre() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, Btn1, Btn2 As Object

On Error GoTo Err_Barre

Flag = SupprimeMaBarre
Flag = False

On Error Resume Next
Set BarreMenu = Application.CommandBars.Add("MaBarre")
With BarreMenu
Set Btn1 = .Controls.Add(msoControlButton)
With Btn1
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 70
'.Style = msoButtonCaption 'Si en rem FaceID assume
'passage paramètre dans une variable
'Chainnecommande = "'UnePourDeux """ & Btn1.Caption & """'"
.OnAction = "Module1.TestXLA" 'ChaineCommande
.TooltipText = "Test déplacement de feuille par XLA"
End With

Set Btn2 = .Controls.Add(msoControlButton)
With Btn2
.Caption = "Second bouton"
.FaceId = 71
.Style = msoButtonCaption 'Si en rem FaceID assume
.OnAction = "Module1.Test"
End With
.Position = msoBarTop
.Visible = True
End With
AjoutMaBarre = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMaBarre = False
Texte = "Erreur dans la routine AjoutMaBarre"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMaBarre() As Boolean

Dim MsgTexte As String

On Error Resume Next
Application.CommandBars("MaBarre").Delete
SupprimeMaBarre = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMaBarre = False
MsgTexte = "Erreur dans la routine SupprimeMaBarre du classeur
Astuces.xla!"
MsgTexte = MsgTexte & " et le classeur actif est :" & ActiveWorkbook.Name
MsgBox MsgTexte & vbCrLf & Err.Number & " - " & Err.Description

End Function
'

bonjours,
Les macros sont accrochés sur des [bouton]
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

Bonjours,
tout d'abord merci pour ta réponse.... Mais il y a un ptit pb: je suis
débutant en VBA, et mes connaissances sont très limités. En résumé je ne
comprend pas grand chose à ce que tu m'a écris.
Du coup je vais reformuler le pb: Le principe, c'est que j'ai une macro
rataché à une zone de texte.
Voici cette macro:

Workbooks.Open ("C:Bandetype.xls")
ActiveWindow.WindowState = xlMaximized
ActiveWorkbook.SaveCopyAs ("C:BandeNouvelle Bande.xls")
Workbooks.Open ("C:BandeNouvelle bande.xls")
Application.WindowState = xlMaximized
Windows("Bandetype.xls").Close
Application.DisplayAlerts = False
Sheets("Création").Select

End Sub


Mon pb, c'est qu'une fois ma "nouvelle bande" créée, les macros affectées à
"bande type" ne fonctionnent plus. Serait-il possible, en quelques lignes, de
faire en sorte que les "bandes types" de mes macros se transforment en
"nouvelle bande" dans le nouveau classeur?
Merci d'avance...
--
Flo Charo

Slt,

Voilà ce que ça donne sur des boutons, les macros affectent le classeur actif.
Ce module est enregistrer dans un classeur nommer en xla "Astuces.xla".
Tel que préciser, les fonctions de création et de supression de la barre
d'outils
sont appellées par les évènements d'ouverture/fermeture du classeur.

Option Explicit

Sub TestXLA()
If Not (ActiveWorkbook Is Nothing) Then
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil1").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil1").Select
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Sub Test()
If Not (ActiveWorkbook Is Nothing) Then
DoEvents
MsgBox "En cours !"
DoEvents
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Function AjoutMaBarre() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, Btn1, Btn2 As Object

On Error GoTo Err_Barre

Flag = SupprimeMaBarre
Flag = False

On Error Resume Next
Set BarreMenu = Application.CommandBars.Add("MaBarre")
With BarreMenu
Set Btn1 = .Controls.Add(msoControlButton)
With Btn1
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 70
'.Style = msoButtonCaption 'Si en rem FaceID assume
'passage paramètre dans une variable
'Chainnecommande = "'UnePourDeux """ & Btn1.Caption & """'"
.OnAction = "Module1.TestXLA" 'ChaineCommande
.TooltipText = "Test déplacement de feuille par XLA"
End With

Set Btn2 = .Controls.Add(msoControlButton)
With Btn2
.Caption = "Second bouton"
.FaceId = 71
.Style = msoButtonCaption 'Si en rem FaceID assume
.OnAction = "Module1.Test"
End With
.Position = msoBarTop
.Visible = True
End With
AjoutMaBarre = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMaBarre = False
Texte = "Erreur dans la routine AjoutMaBarre"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMaBarre() As Boolean

Dim MsgTexte As String

On Error Resume Next
Application.CommandBars("MaBarre").Delete
SupprimeMaBarre = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMaBarre = False
MsgTexte = "Erreur dans la routine SupprimeMaBarre du classeur
Astuces.xla!"
MsgTexte = MsgTexte & " et le classeur actif est :" & ActiveWorkbook.Name
MsgBox MsgTexte & vbCrLf & Err.Number & " - " & Err.Description

End Function
'

bonjours,
Les macros sont accrochés sur des [bouton]
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

re:

en premier je me permets queuques modifs sur la routine :

Sub TestVBA()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Workbooks.Open ("C:Bandetype.xls")
ActiveWorkbook.SaveCopyAs ("C:BandeNouvelle Bande.xls")
Workbooks.Open ("C:BandeNouvelle bande.xls")
Workbooks("Bandetype.xls").Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Sheets("Création").Select

End Sub

Pour être sur qu'une macro soit intègre au classeur, tu indiques en début de
module [ Option Private Module ].

Ensuite, ce ne doit pas être cette macro qui est dans le fichier
"BandeType.xls",
si j'ai bien compris bien sur.

En fait, tu as d'autres macros qui se trouvent dans le classeur
"BandeType.xls" ?
Et la ligne [Windows("Bandetype.xls").Close] ferme vraiment le fichier de
base ?

Donc allons-y pas à pas !

Répond à ces 2 questions !

mousnynao

Bonjours,
tout d'abord merci pour ta réponse.... Mais il y a un ptit pb: je suis
débutant en VBA, et mes connaissances sont très limités. En résumé je ne
comprend pas grand chose à ce que tu m'a écris.
Du coup je vais reformuler le pb: Le principe, c'est que j'ai une macro
rataché à une zone de texte.
Voici cette macro:

Workbooks.Open ("C:Bandetype.xls")
ActiveWindow.WindowState = xlMaximized
ActiveWorkbook.SaveCopyAs ("C:BandeNouvelle Bande.xls")
Workbooks.Open ("C:BandeNouvelle bande.xls")
Application.WindowState = xlMaximized
Windows("Bandetype.xls").Close
Application.DisplayAlerts = False
Sheets("Création").Select

End Sub


Mon pb, c'est qu'une fois ma "nouvelle bande" créée, les macros affectées à
"bande type" ne fonctionnent plus. Serait-il possible, en quelques lignes, de
faire en sorte que les "bandes types" de mes macros se transforment en
"nouvelle bande" dans le nouveau classeur?
Merci d'avance...
--
Flo Charo

Slt,

Voilà ce que ça donne sur des boutons, les macros affectent le classeur actif.
Ce module est enregistrer dans un classeur nommer en xla "Astuces.xla".
Tel que préciser, les fonctions de création et de supression de la barre
d'outils
sont appellées par les évènements d'ouverture/fermeture du classeur.

Option Explicit

Sub TestXLA()
If Not (ActiveWorkbook Is Nothing) Then
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil1").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil1").Select
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Sub Test()
If Not (ActiveWorkbook Is Nothing) Then
DoEvents
MsgBox "En cours !"
DoEvents
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Function AjoutMaBarre() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, Btn1, Btn2 As Object

On Error GoTo Err_Barre

Flag = SupprimeMaBarre
Flag = False

On Error Resume Next
Set BarreMenu = Application.CommandBars.Add("MaBarre")
With BarreMenu
Set Btn1 = .Controls.Add(msoControlButton)
With Btn1
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 70
'.Style = msoButtonCaption 'Si en rem FaceID assume
'passage paramètre dans une variable
'Chainnecommande = "'UnePourDeux """ & Btn1.Caption & """'"
.OnAction = "Module1.TestXLA" 'ChaineCommande
.TooltipText = "Test déplacement de feuille par XLA"
End With

Set Btn2 = .Controls.Add(msoControlButton)
With Btn2
.Caption = "Second bouton"
.FaceId = 71
.Style = msoButtonCaption 'Si en rem FaceID assume
.OnAction = "Module1.Test"
End With
.Position = msoBarTop
.Visible = True
End With
AjoutMaBarre = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMaBarre = False
Texte = "Erreur dans la routine AjoutMaBarre"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMaBarre() As Boolean

Dim MsgTexte As String

On Error Resume Next
Application.CommandBars("MaBarre").Delete
SupprimeMaBarre = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMaBarre = False
MsgTexte = "Erreur dans la routine SupprimeMaBarre du classeur
Astuces.xla!"
MsgTexte = MsgTexte & " et le classeur actif est :" & ActiveWorkbook.Name
MsgBox MsgTexte & vbCrLf & Err.Number & " - " & Err.Description

End Function
'

bonjours,
Les macros sont accrochés sur des [bouton]
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo

re:

lorsque 2 classeurs possèdent les mêmes macros, l'appel se fait sur
la dernière appellé quelque soit le classeur actif. C'est pourquoi, une
fois la copie réalisé, il est vital de fermer l'original de façon à ne pas
brouillé les liens.

Pour ma part, j'ai résolu ce problème en envoyant mes macros dans
un xla qui devient indépendant du classeur actif. (Comme l'exemple
dans précédent message.

mousnynao

Bonjours,
tout d'abord merci pour ta réponse.... Mais il y a un ptit pb: je suis
débutant en VBA, et mes connaissances sont très limités. En résumé je ne
comprend pas grand chose à ce que tu m'a écris.
Du coup je vais reformuler le pb: Le principe, c'est que j'ai une macro
rataché à une zone de texte.
Voici cette macro:

Workbooks.Open ("C:Bandetype.xls")
ActiveWindow.WindowState = xlMaximized
ActiveWorkbook.SaveCopyAs ("C:BandeNouvelle Bande.xls")
Workbooks.Open ("C:BandeNouvelle bande.xls")
Application.WindowState = xlMaximized
Windows("Bandetype.xls").Close
Application.DisplayAlerts = False
Sheets("Création").Select

End Sub


Mon pb, c'est qu'une fois ma "nouvelle bande" créée, les macros affectées à
"bande type" ne fonctionnent plus. Serait-il possible, en quelques lignes, de
faire en sorte que les "bandes types" de mes macros se transforment en
"nouvelle bande" dans le nouveau classeur?
Merci d'avance...
--
Flo Charo

Slt,

Voilà ce que ça donne sur des boutons, les macros affectent le classeur actif.
Ce module est enregistrer dans un classeur nommer en xla "Astuces.xla".
Tel que préciser, les fonctions de création et de supression de la barre
d'outils
sont appellées par les évènements d'ouverture/fermeture du classeur.

Option Explicit

Sub TestXLA()
If Not (ActiveWorkbook Is Nothing) Then
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil1").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil1").Select
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Sub Test()
If Not (ActiveWorkbook Is Nothing) Then
DoEvents
MsgBox "En cours !"
DoEvents
Else
MsgBox "Aucun classeur d'actif !"
End If
End Sub
'

Function AjoutMaBarre() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, Btn1, Btn2 As Object

On Error GoTo Err_Barre

Flag = SupprimeMaBarre
Flag = False

On Error Resume Next
Set BarreMenu = Application.CommandBars.Add("MaBarre")
With BarreMenu
Set Btn1 = .Controls.Add(msoControlButton)
With Btn1
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 70
'.Style = msoButtonCaption 'Si en rem FaceID assume
'passage paramètre dans une variable
'Chainnecommande = "'UnePourDeux """ & Btn1.Caption & """'"
.OnAction = "Module1.TestXLA" 'ChaineCommande
.TooltipText = "Test déplacement de feuille par XLA"
End With

Set Btn2 = .Controls.Add(msoControlButton)
With Btn2
.Caption = "Second bouton"
.FaceId = 71
.Style = msoButtonCaption 'Si en rem FaceID assume
.OnAction = "Module1.Test"
End With
.Position = msoBarTop
.Visible = True
End With
AjoutMaBarre = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMaBarre = False
Texte = "Erreur dans la routine AjoutMaBarre"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMaBarre() As Boolean

Dim MsgTexte As String

On Error Resume Next
Application.CommandBars("MaBarre").Delete
SupprimeMaBarre = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMaBarre = False
MsgTexte = "Erreur dans la routine SupprimeMaBarre du classeur
Astuces.xla!"
MsgTexte = MsgTexte & " et le classeur actif est :" & ActiveWorkbook.Name
MsgBox MsgTexte & vbCrLf & Err.Number & " - " & Err.Description

End Function
'

bonjours,
Les macros sont accrochés sur des [bouton]
--
Flo Charo

re:

Les macros sont accrochés sur quel type d'objet !

menu][feuille] ?

Spécifie l'objet et je pourrai t'aider pour la syntaxe !

mousnynao

Merci, je vais essayer
--
Flo Charo

Bonjour,

Suggestion :

Gestion dynamique des liens !

Exemple de menu dynamique :

Les fonctions AjoutMonMenu et SupprimeMonMenu
sont appellés par
[ ThisWorkBook.Workbook_Open() & ThisWorkBook.Workbook_BeforeClose(Cancel As
Boolean) ]

Sub TestXLA()
ActiveWorkbook.Sheets("Feuil1").Select
MsgBox ActiveWorkbook.Sheets("Feuil2").Range("D4").Value
MsgBox ActiveWorkbook.Sheets("Feuil3").Range("D4").Value
ActiveWorkbook.Sheets("Feuil3").Select
End Sub
'

Sub Test()
DoEvents
MsgBox "En cours !"
DoEvents
End Sub
'

Function AjoutMonMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMonMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Astuces"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Test déplacement de feuille par XLA"
.OnAction = "Module1.TestXLA"
.FaceId = 2579
End With


Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Nouveau"
.OnAction = "Test"
.FaceId = 222
End With

AjoutMonMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutMonMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMonMenu() ' As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMonMenu = True

Exit_Close:
Exit Function

Err_Close:
SupprimeMonMenu = False
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description

End Function

mousnynao

Bonjours et bonne année,
Je veux, à partir d'un classeur type, créer des classeurs spéfique à telle
ou telle personne, avec le nom de la personne concernée. J'arrive à copier
mon classeur type, et à le renomer, seulement je n'arrive pas à faire en
sorte que les macros s'addaptent aux nouveaux noms de mes classeurs. Y a-t-il
un moyen de mettre à jours les macro automatiquement ?
Merci d'avance...
--
Flo Charo