Ruban xml avec chekbox - Codes VBA
Bonjour à tous,
j'ai un fichier sous excel 2007 qui contient une quarataine de colonnes.
Dans mon ruban de commande personnalisé, j'ai créé un groupe "affichage des colonnes", contenant des cases à cocher, avec comme fonction de masquer ou d'afficher les colonnes.
Mon code xml est:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="tab1" label="Perso" >
<group id="GR01" label="Affichage des colonnes">
<checkBox id="CheckBox1" label="B" onAction="ColonneB" />
<checkBox id="CheckBox2" label="C" onAction="ColonneC" />
<checkBox id="CheckBox3" label="D" onAction="ColonneD" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
Mon code VBA est:
Sub ColonneB(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox1") Then
Columns("B:B").Select
Selection.EntireColumn.Hidden = False
Else
Columns("B:B").Select
Selection.EntireColumn.Hidden = True
End If
End Sub
Sub ColonneC(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox2") Then
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Else
Columns("C:C").Select
Selection.EntireColumn.Hidden = False
End If
End Sub
Sub ColonneD(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox3") Then
Columns("D:D").Select
Selection.EntireColumn.Hidden = True
Else
Columns("D:D").Select
Selection.EntireColumn.Hidden = False
End If
End Sub
Mon problème:
Quand je coche les cases, les colonnes se masquent, quand je décoche les cases, les colonnes ne réapparaissent pas!?!
Merci d'avance pour le coup de main...
Bonjour,
Essaie :
Sub ColonneB(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox1") Then
With Columns("B:B").EntireColumn
.Hidden = Not .Hidden = True
End With
End If
End Sub
Sub ColonneC(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox2") Then
With Columns("C:C").EntireColumn
.Hidden = Not .Hidden = True
End With
End If
End Sub
Sub ColonneD(control As IRibbonControl, pressed As Boolean)
If (control.ID = "CheckBox3") Then
With Columns("D:D").EntireColumn
.Hidden = Not .Hidden = True
End With
End If
End Sub(non testé)
A+
Nikel!
Sauf que je me suis trompé, quand tout est décoché, toutes les colonnes doivent être masquées, et quand on coche, les colonnes doivent apparaitre... dsl pour ma 1ere fausse explication...
Et une commande pour tout décocher (tout masquer sauf la colonne A) et une autre pour tout cocher (tout afficher) serait le top, lol!
Hum,
On va faire un essai :
Modifier le xml comme suit :
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="tab1" label="Perso" >
<group id="GR01" label="Affichage des colonnes">
<checkBox id="CheckBox1" label="B" onAction="HCol" />
<checkBox id="CheckBox2" label="C" onAction="HCol" />
<checkBox id="CheckBox3" label="D" onAction="HCol" />
<checkBox id="CheckBox4" label="B-D" onAction="HCol" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>Et dans le VBA :
Sub HCol(control As IRibbonControl, pressed As Boolean)
Dim NiD%, S$
NiD = CInt(Right(control.ID, 1))
Select Case NiD
Case 1: S = "B:B"
Case 2: S = "C:C"
Case 3: S = "D:D"
Case 4: S = "B:D"
End Select
If (control.ID = "CheckBox" & NiD) Then
With Columns(S).EntireColumn
.Hidden = IIf(pressed, False, True)
End With
End If
End SubAvec ce 4° contrôle il y a un effet de chevauchement (contradiction) pas forcément agréable. Si tu es très à l'aise avec xml, il a peut-être moyen de cocher ou décocher les 3 premiers contrôles quand tu utilises le 4°...
Je n'ai pas essayé : Personnellement je supprimerai ce dernier contrôle peu pratique.
Finalement c'est possible : j'ai testé avec des callbacks. Malgré tout ça donne un résultat, à mon avis peu ergonomique. S'il y avait une douzaine de checkbox le jeu en vaudrait peut-être la chandelle, mais pour 3, je reste sur mon opinion précédente...
A+
Bonjour,
excusez ma réponse tardive à votre aide, j'étais en arrêt et ne pouvait donc plus m'occuper de ce programme.
J'ai essayé votre méthode, c'est presque ça...
Je joins une capture d'écran de mon ruban pour que ce soit plus compréhensible.
Donc à présent, toutes mes cases à cocher masquent ou affichent la colonne souhaitée (l'ordre des checkbox de mon ruban ne correspond pas forcément à l'ordre alphabétique des colonnes).
Il me manque donc 3 choses:
1- à l'ouverture du fichier, toutes les checkbox doivent être décochées et donc les colonnes correspondantes masquées.
2- lorsque j'appuie sur mon bouton "Tout afficher", tous les checkbox doivent se cocher automatiquement, et donc afficher toutes les colonnes correspondantes.
3- lorsque j'appuie sur mon bouton "Tout masquer", tous les checkbox doivent se décocher automatiquement, et donc masquer toutes les colonnes correspondantes.
(Voilà, le but est simple: nous sommes plusieurs utilisateurs sur ce fichier partagé qui comportent à ce jour 52 colonnes, chacun travaillant avec un affichage de colonne différent, ce sera très pratique et rapide d'accès...)
Merci beaucoup pour votre aide.
Olivier.
Bonsoir,
Joindre le fichier.
Vous pouvez supprimer le contenu de toutes les feuilles mais vous devez laisser laisser subsister tout ce qui concerne les codes d'accès nécessaires et le code relatif au ribbon.
A+
Bonjour,
Finalement j'ai pas mal modifier TOUSSA !
Le XML du ribbon :
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="RibbonOnLoad">
<ribbon startFromScratch="true">
<!-- Groupe dossiers d'intervention-->
<group id="GR014" label="Dossiers d'intervention">
<checkBox id="CheckBox01" label="Numéro de DI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox02" label="Numéro d'OI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox03" label="Numéro d'OIS" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox04" label="Libellé DI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox05" label="Libellé OI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox06" label="Indice" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox07" label="Nature DI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox08" label="Etat OI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox09" label="Localisation" onAction="DisAct" getPressed="GetChkBox_pressed" />
</group>
<!-- Groupe BDMAT-->
<group id="GR015" label="BDMAT">
<checkBox id="CheckBox10" label="Fabricant" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox11" label="RIN" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox12" label="N° de MI" onAction="DisAct" getPressed="GetChkBox_pressed" />
<checkBox id="CheckBox13" label="Famille" onAction="DisAct" getPressed="GetChkBox_pressed" />
<!-- et ainsi de suite -->Le code du module correspondant :
Public STATUS(1 To 38) As Boolean
Public oRibbon As IRibbonUI
Sub RibbonOnLoad(Ribbon As IRibbonUI)
Set oRibbon = Ribbon
End Sub
Sub DisAff(i As Byte, Y)
STATUS(i) = Y
Z = NC(i)
Columns(Z).Hidden = Y
End Sub
Sub TOUTMAS(control As IRibbonControl) 'Bouton "Tout masquer"
Dim k As Byte, Y As Boolean, kk$
For k = 1 To UBound(STATUS)
Y = False
DisAff k, Y
kk = IIf(k < 10, "0" & k, k)
oRibbon.InvalidateControl "CheckBox" & kk
Next
End Sub
Sub TOUTAFF(control As IRibbonControl) 'Bouton "Tout masquer" k
Dim k As Byte, Y As Boolean, kk$
For k = 1 To UBound(STATUS)
Y = True
DisAff k, Y
kk = IIf(k < 10, "0" & k, k)
oRibbon.InvalidateControl "CheckBox" & kk
Next
End Sub
Sub DisAct(control As IRibbonControl, pressed As Boolean)
Dim i As Byte, Y As Boolean
i = CByte(Right(control.ID, 2))
Y = Not pressed
DisAff i, Y
End Sub
Sub GetChkBox_pressed(control As IRibbonControl, ByRef pressed)
Dim i As Byte
i = CByte(Right(control.ID, 2))
pressed = Not STATUS(i)
End Sub
Function NC$(k As Byte)
'Attention correspondance des colonnes à vérifier !
Arr = Split("C E AE B D AF AC F G " & _
"J K L AI Q M O N P " & _
"R T R S U " & _
"AD AG AN H I " & _
"V W Z X Y AB AA " & _
"AL AO AP")
NC = Arr(k - 1)
End FunctionCode du ThisWorkbook :
Private Sub Workbook_Open()
Dim k As Byte
Application.ScreenUpdating = False
For k = 1 To UBound(STATUS)
DisAff k, True
Next
End SubA+