Re : Application VBA
Re
Comme cela par exemple, à adapter:
Code VBA:
Sub Creer_bo3()
'MJ
Dim MaBar As CommandBar, Btn1, Btn2
''on error resume next
'For n = 1 To CommandBars.Count
'If CommandBars(n).Name = "MJ Utilitaire 2009" Then Exit Sub
'Next n
'Stop
nomact = ThisWorkbook.Name
delBO3
'Pour ne pas avoir la barre quand on ferme Excel
'Set MaBar = Application.CommandBars.Add("MJ Utilitaire 2009", , , temporary:=True)
'Pour avoir toujours la barre avec sauvegarde de l'emplacement quand on ferme Excel
Set MaBar = Application.CommandBars.Add("MJ Utilitaire 2009")
'MaBar.Protection = msoBarNoChangeVisible
With MaBar
Set Btn1 = .Controls.Add(msoControlButton)
With Btn1
If Windows(nomact).Visible = True Then .Caption = "Affiche" Else .Caption = "Masque"
End With
With Btn1 '*********
.Caption = "Affiche"
.Style = msoButtonIconAndCaption
'.FaceId = 39
If Windows(nomact).Visible = True Then .OnAction = "Affiche" Else .OnAction = "Masque"
End With
''''''Création Bouton MJV4
Set Btn2 = .Controls.Add(msoControlButton)
With Btn2
'If Windows(nomact).Visible = True Then .Caption = "Affiche" Else .Caption = "Masque"
End With
With Btn2
.Caption = "MJV4"
.Style = msoButtonIconAndCaption
'.FaceId = 39
.OnAction = "'" & ThisWorkbook.Name & "'!lance"
'If Windows(nomact).Visible = True Then .OnAction = "Affiche" Else .OnAction = "Masque"
End With
'''''''Création Bouton MJV4
'*********
Application.CommandBars("MJ Utilitaire 2009").Controls.Add Type:= _
msoControlPopup, Before:=2
'*****
With Application.CommandBars("MJ Utilitaire 2009").Controls(2)
.Caption = "Feuilles"
.TooltipText = "Feuilles N"
'***
For i = 1 To ActiveWorkbook.Sheets.Count 'Range("a65536").End(xlUp).Rows.Row
Set c2 = .Controls.Add(msoControlButton)
With c2 '**
'.Tag = "test"
.Caption = Sheets(i).Name '"texte" & I 'Cells(I, 1).Value
'.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.OnAction = ThisWorkbook.Name & "!Active_Feuille" & i
.TooltipText = Sheets(i).Name 'Cells(I, 2).Value
End With '**
Next
'***
End With
'*****
.Position = msoBarTop
.Visible = True
.Position = msoBarTop
.Visible = True
End With
End Sub
Sub delBO3()
On Error Resume Next
Application.CommandBars("MJ Utilitaire 2009").Delete
End Sub
Sub Active_Feuille()
'Ne fonctionne pas. Donc solution un peu plus longue en dessous quoique avec Incremente_macro c'est assez rapide.
Stop
GoTo suite:
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Application
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).BuiltIn
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Caption
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Creator
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).DescriptionText
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).ID
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Index
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).IsPriorityDropped
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).OLEUsage
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).OnAction
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Parameter
'NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Parent
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Priority
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Tag
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).TooltipText
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Top
NomF = CommandBars("MJ Utilitaire 2009").Controls(2).Type
suite:
'NomF = CommandBars("MJ Utilitaire 2009").FindControl(1, Tag:="aa").Index
'ActiveWorkbook.Names.Add Name:="Feuil1", RefersToR1C1:="=""Utilitaire MJ"""
Sheets(1).Select
End Sub
Sub Incremente_macro()
' Macro enregistrée le 03/11/2009 par MJ
'Attention si plus de 40 feuilles dans le classeur, privilégiez le sommaire.
For i = 1 To 40
ActiveCell.FormulaR1C1 = "Sub Active_Feuille" & i & "()"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "If ActiveWorkbook.Sheets(" & i & ").Visible = False Then ActiveWorkbook.Sheets(" & i & ").Visible = True: ActiveWorkbook.Sheets(" & i & ").Select: Exit Sub"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "ActiveWorkbook.Sheets(" & i & ").Select"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "End Sub"
ActiveCell.Offset(1, 0).Range("A1").Select
Next
End Sub
Sub Active_Feuille1()
If ActiveWorkbook.Sheets(1).Visible = False Then ActiveWorkbook.Sheets(1).Visible = True: ActiveWorkbook.Sheets(1).Select: Exit Sub
ActiveWorkbook.Sheets(1).Select
End Sub
Sub Active_Feuille2()
If ActiveWorkbook.Sheets(2).Visible = False Then ActiveWorkbook.Sheets(2).Visible = True: ActiveWorkbook.Sheets(2).Select: Exit Sub
ActiveWorkbook.Sheets(2).Select
End Sub
Sub Active_Feuille3()
If ActiveWorkbook.Sheets(3).Visible = False Then ActiveWorkbook.Sheets(3).Visible = True: ActiveWorkbook.Sheets(3).Select: Exit Sub
ActiveWorkbook.Sheets(3).Select
End Sub
Sub Active_Feuille4()
If ActiveWorkbook.Sheets(4).Visible = False Then ActiveWorkbook.Sheets(4).Visible = True: ActiveWorkbook.Sheets(4).Select: Exit Sub
ActiveWorkbook.Sheets(4).Select
End Sub
Sub Active_Feuille5()
If ActiveWorkbook.Sheets(5).Visible = False Then ActiveWorkbook.Sheets(5).Visible = True: ActiveWorkbook.Sheets(5).Select: Exit Sub
ActiveWorkbook.Sheets(5).Select
End Sub
Sub Active_Feuille6()
If ActiveWorkbook.Sheets(6).Visible = False Then ActiveWorkbook.Sheets(6).Visible = True: ActiveWorkbook.Sheets(6).Select: Exit Sub
ActiveWorkbook.Sheets(6).Select
End Sub
Sub Active_Feuille7()
If ActiveWorkbook.Sheets(7).Visible = False Then ActiveWorkbook.Sheets(7).Visible = True: ActiveWorkbook.Sheets(7).Select: Exit Sub
ActiveWorkbook.Sheets(7).Select
End Sub
Sub Active_Feuille8()
If ActiveWorkbook.Sheets(8).Visible = False Then ActiveWorkbook.Sheets(8).Visible = True: ActiveWorkbook.Sheets(8).Select: Exit Sub
ActiveWorkbook.Sheets(8).Select
End Sub
Sub Active_Feuille9()
If ActiveWorkbook.Sheets(9).Visible = False Then ActiveWorkbook.Sheets(9).Visible = True: ActiveWorkbook.Sheets(9).Select: Exit Sub
ActiveWorkbook.Sheets(9).Select
End Sub
Sub Active_Feuille10()
If ActiveWorkbook.Sheets(10).Visible = False Then ActiveWorkbook.Sheets(10).Visible = True: ActiveWorkbook.Sheets(10).Select: Exit Sub
ActiveWorkbook.Sheets(10).Select
End Sub
Sub Active_Feuille11()
If ActiveWorkbook.Sheets(11).Visible = False Then ActiveWorkbook.Sheets(11).Visible = True: ActiveWorkbook.Sheets(11).Select: Exit Sub
ActiveWorkbook.Sheets(11).Select
End Sub
Sub Active_Feuille12()
If ActiveWorkbook.Sheets(12).Visible = False Then ActiveWorkbook.Sheets(12).Visible = True: ActiveWorkbook.Sheets(12).Select: Exit Sub
ActiveWorkbook.Sheets(12).Select
End Sub
Sub Active_Feuille13()
If ActiveWorkbook.Sheets(13).Visible = False Then ActiveWorkbook.Sheets(13).Visible = True: ActiveWorkbook.Sheets(13).Select: Exit Sub
ActiveWorkbook.Sheets(13).Select
End Sub
Sub Active_Feuille14()
If ActiveWorkbook.Sheets(14).Visible = False Then ActiveWorkbook.Sheets(14).Visible = True: ActiveWorkbook.Sheets(14).Select: Exit Sub
ActiveWorkbook.Sheets(14).Select
End Sub
Sub Active_Feuille15()
If ActiveWorkbook.Sheets(15).Visible = False Then ActiveWorkbook.Sheets(15).Visible = True: ActiveWorkbook.Sheets(15).Select: Exit Sub
ActiveWorkbook.Sheets(15).Select
End Sub
Sub Active_Feuille16()
If ActiveWorkbook.Sheets(16).Visible = False Then ActiveWorkbook.Sheets(16).Visible = True: ActiveWorkbook.Sheets(16).Select: Exit Sub
ActiveWorkbook.Sheets(16).Select
End Sub
Sub Active_Feuille17()
If ActiveWorkbook.Sheets(17).Visible = False Then ActiveWorkbook.Sheets(17).Visible = True: ActiveWorkbook.Sheets(17).Select: Exit Sub
ActiveWorkbook.Sheets(17).Select
End Sub
Sub Active_Feuille18()
If ActiveWorkbook.Sheets(18).Visible = False Then ActiveWorkbook.Sheets(18).Visible = True: ActiveWorkbook.Sheets(18).Select: Exit Sub
ActiveWorkbook.Sheets(18).Select
End Sub
Sub Active_Feuille19()
If ActiveWorkbook.Sheets(19).Visible = False Then ActiveWorkbook.Sheets(19).Visible = True: ActiveWorkbook.Sheets(19).Select: Exit Sub
ActiveWorkbook.Sheets(19).Select
End Sub
Sub Active_Feuille20()
If ActiveWorkbook.Sheets(20).Visible = False Then ActiveWorkbook.Sheets(20).Visible = True: ActiveWorkbook.Sheets(20).Select: Exit Sub
ActiveWorkbook.Sheets(20).Select
End Sub
Sub Active_Feuille21()
If ActiveWorkbook.Sheets(21).Visible = False Then ActiveWorkbook.Sheets(21).Visible = True: ActiveWorkbook.Sheets(21).Select: Exit Sub
ActiveWorkbook.Sheets(21).Select
End Sub
Sub Active_Feuille22()
If ActiveWorkbook.Sheets(22).Visible = False Then ActiveWorkbook.Sheets(22).Visible = True: ActiveWorkbook.Sheets(22).Select: Exit Sub
ActiveWorkbook.Sheets(22).Select
End Sub
Sub Active_Feuille23()
If ActiveWorkbook.Sheets(23).Visible = False Then ActiveWorkbook.Sheets(23).Visible = True: ActiveWorkbook.Sheets(23).Select: Exit Sub
ActiveWorkbook.Sheets(23).Select
End Sub
Sub Active_Feuille24()
If ActiveWorkbook.Sheets(24).Visible = False Then ActiveWorkbook.Sheets(24).Visible = True: ActiveWorkbook.Sheets(24).Select: Exit Sub
ActiveWorkbook.Sheets(24).Select
End Sub
Sub Active_Feuille25()
If ActiveWorkbook.Sheets(25).Visible = False Then ActiveWorkbook.Sheets(25).Visible = True: ActiveWorkbook.Sheets(25).Select: Exit Sub
ActiveWorkbook.Sheets(25).Select
End Sub
Sub Active_Feuille26()
If ActiveWorkbook.Sheets(26).Visible = False Then ActiveWorkbook.Sheets(26).Visible = True: ActiveWorkbook.Sheets(26).Select: Exit Sub
ActiveWorkbook.Sheets(26).Select
End Sub
Sub Active_Feuille27()
If ActiveWorkbook.Sheets(27).Visible = False Then ActiveWorkbook.Sheets(27).Visible = True: ActiveWorkbook.Sheets(27).Select: Exit Sub
ActiveWorkbook.Sheets(27).Select
End Sub
Sub Active_Feuille28()
If ActiveWorkbook.Sheets(28).Visible = False Then ActiveWorkbook.Sheets(28).Visible = True: ActiveWorkbook.Sheets(28).Select: Exit Sub
ActiveWorkbook.Sheets(28).Select
End Sub
Sub Active_Feuille29()
If ActiveWorkbook.Sheets(29).Visible = False Then ActiveWorkbook.Sheets(29).Visible = True: ActiveWorkbook.Sheets(29).Select: Exit Sub
ActiveWorkbook.Sheets(29).Select
End Sub
Sub Active_Feuille30()
If ActiveWorkbook.Sheets(30).Visible = False Then ActiveWorkbook.Sheets(30).Visible = True: ActiveWorkbook.Sheets(30).Select: Exit Sub
ActiveWorkbook.Sheets(30).Select
End Sub
Sub Active_Feuille31()
If ActiveWorkbook.Sheets(31).Visible = False Then ActiveWorkbook.Sheets(31).Visible = True: ActiveWorkbook.Sheets(31).Select: Exit Sub
ActiveWorkbook.Sheets(31).Select
End Sub
Sub Active_Feuille32()
If ActiveWorkbook.Sheets(32).Visible = False Then ActiveWorkbook.Sheets(32).Visible = True: ActiveWorkbook.Sheets(32).Select: Exit Sub
ActiveWorkbook.Sheets(32).Select
End Sub
Sub Active_Feuille33()
If ActiveWorkbook.Sheets(33).Visible = False Then ActiveWorkbook.Sheets(33).Visible = True: ActiveWorkbook.Sheets(33).Select: Exit Sub
ActiveWorkbook.Sheets(33).Select
End Sub
Sub Active_Feuille34()
If ActiveWorkbook.Sheets(34).Visible = False Then ActiveWorkbook.Sheets(34).Visible = True: ActiveWorkbook.Sheets(34).Select: Exit Sub
ActiveWorkbook.Sheets(34).Select
End Sub
Sub Active_Feuille35()
If ActiveWorkbook.Sheets(35).Visible = False Then ActiveWorkbook.Sheets(35).Visible = True: ActiveWorkbook.Sheets(35).Select: Exit Sub
ActiveWorkbook.Sheets(35).Select
End Sub
Sub Active_Feuille36()
If ActiveWorkbook.Sheets(36).Visible = False Then ActiveWorkbook.Sheets(36).Visible = True: ActiveWorkbook.Sheets(36).Select: Exit Sub
ActiveWorkbook.Sheets(36).Select
End Sub
Sub Active_Feuille37()
If ActiveWorkbook.Sheets(37).Visible = False Then ActiveWorkbook.Sheets(37).Visible = True: ActiveWorkbook.Sheets(37).Select: Exit Sub
ActiveWorkbook.Sheets(37).Select
End Sub
Sub Active_Feuille38()
If ActiveWorkbook.Sheets(38).Visible = False Then ActiveWorkbook.Sheets(38).Visible = True: ActiveWorkbook.Sheets(38).Select: Exit Sub
ActiveWorkbook.Sheets(38).Select
End Sub
Sub Active_Feuille39()
If ActiveWorkbook.Sheets(39).Visible = False Then ActiveWorkbook.Sheets(39).Visible = True: ActiveWorkbook.Sheets(39).Select: Exit Sub
ActiveWorkbook.Sheets(39).Select
End Sub
Sub Active_Feuille40()
If ActiveWorkbook.Sheets(40).Visible = False Then ActiveWorkbook.Sheets(40).Visible = True: ActiveWorkbook.Sheets(40).Select: Exit Sub
ActiveWorkbook.Sheets(40).Select
End Sub