[XL-2003] Modidier macros mais comment?

Modidier macros mais comment?

Bonjour le forum
Je ne peux pas fournir de fichier héls plus simple pour vous
J'affiche les colonnes K L P en double cliquant sur cellule A2 de chaque onglets
Je voudrais faire un double click toujours sur cellule A2 pour afficher les colonnes K L P sur tout le classeur et non onglet par onglet
Ensuite à l'enregistrement faire fermer les colonnes K L P sur tout le classeur et non faire un double cellule A2 onglet par onglet
J'ai "bricolé" les macros Double click et Save mais ça mais ça ne va pas
Donc je vien vers vous pour tenter de trouver une solution
Merci d'avance
Cordialement

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'Colonnes discontinue 3ème façon
Dim i As Long
For i = 1 To Sheets.Count
If Sheets(i).Name <> "LISTE_PRATICIENS" Then
If Target.Address = "$A$2" Then
Cancel = True
Application.ScreenUpdating = False
With Range("K:P").EntireColumn
.Hidden = False
End With
Columns("M:O").Hidden = True
End If
End If
Next i
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Integer
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
If Sheets(i).Name <> "LISTE_PRATICIENS" Then
Cancel = True
With Range("K:P").EntireColumn
.Hidden = True
End With
Columns("M:O").Hidden = True
End If
Next i

AfficherMasquerOnglets 2
For i = 2 To Sheets.Count
If Sheets(i).Visible = True Then Sheets(i).Select: Exit Sub
Next i
End Sub

Salut, comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
        ShowColumns
        Cancel = True
    End If
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    HideColumns
End Sub
 
Sub ShowColumns()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Columns("K:K").Hidden = False
        ws.Columns("L:L").Hidden = False
        ws.Columns("P:P").Hidden = False
    Next ws
End Sub
 
Sub HideColumns()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Columns("K:K").Hidden = True
        ws.Columns("L:L").Hidden = True
        ws.Columns("P:P").Hidden = True
    Next ws
End Sub

Les 2 premières macros sont à mettre dans les évènements de Workbook et les 2 suivantes dans un module.

Bonjour,
Si j'ai bien compris votre demande, voici le code d'une procédure qui masque et affiche les colonnes K, L et P de toutes les feuilles du classeur à l'exception de celle nommée "LISTE_PRATICIENS"

Procédure à placer dans un module standard ou dans ThisWorkbook
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub ToggleVisibleHide(Optional ToHide As Boolean) Dim sht As Worksheet For Each sht In Worksheets With sht If .Name <> "LISTE_PRATICIENS" Then If ToHide Then .Range("K:L,P:P").EntireColumn.Hidden = True Else .Range("K:L,P:P").EntireColumn.Hidden = Not .Columns("K").Hidden End If End If End With Next Set sht = Nothing End Sub
Procédure qui l'invoque suite à un double clic sur A2
Code:

1 2 3 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$2" Then ToggleVisibleHide: Cancel = True End Sub
Procédure événementielle qui invoque la procédure en cachant les colonnes K, L et P à la fermeture du classeur
Code:

1 2 3 Private Sub Workbook_BeforeClose(Cancel As Boolean) ToggleVisibleHide ToHide:=True End Sub

Citation:
Envoyé par Franc
Salut, comme ceci:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$2" Then ShowColumns Cancel = True End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) HideColumns End Sub Sub ShowColumns() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets ws.Columns("K:K").Hidden = False ws.Columns("L:L").Hidden = False ws.Columns("P:P").Hidden = False Next ws End Sub Sub HideColumns() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets ws.Columns("K:K").Hidden = True ws.Columns("L:L").Hidden = True ws.Columns("P:P").Hidden = True Next ws End Sub
Les 2 premières macros sont à mettre dans les évènements de Workbook et les 2 suivantes dans un module.
J'ai oublié de mettre ça
Avec toutes mes excuses
Ça fait bien le boulot mais TOUS les onglets restent ouvert alors que ça devrait s'ouvrir et se fermer sur LEVET - MAIZONNIAUX
Merci à toi

Option Explicit
Sub LancerAfficherMasquerOnglets() 'Macro pour appeler macro "AfficherMasquerOnglets" pour affectation bouton si la macro n'est pas visible avec Click Droit affecter une macro
AfficherMasquerOnglets 'Nom de la macro qui ne se voit pas avec Click Droit affecter une macro
End Sub
Sub AfficherMasquerOnglets(Optional Affiche As Integer) 'Macro avec paramètres non visible lorsqu'on affecte un bouton
Dim ws As Worksheet, feuille As Worksheet, i As Integer
Dim LesFeuilles

Application.ScreenUpdating = False
Set ws = ActiveSheet
If Affiche = 0 Then
Affiche = xlSheetVeryHidden
For i = 1 To Sheets.Count
If Sheets(i).Visible = xlSheetVeryHidden Then Affiche = True: Exit For
Next i
End If
For Each feuille In Sheets
Select Case feuille.Name
Case "LEVET - MAIZONNIAUX" 'Ouvrir TOUS les ONGLETS avant Ajout de PRATICIENS"
Case Else
With feuille
'.Unprotect
.Visible = Affiche
'.Protect UserInterfaceOnly:=True
End With
End Select
Next feuille
End Sub

Voici 2 macros que je te laisse "finetuner" selon tes besoins.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub CacherOnglets()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "LEVET - MAIZONNIAUX" Then
            ws.Visible = xlSheetHidden
        End If
    Next ws
End Sub
 
Sub MontrerOnglets()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws
End Sub

Bonjour le forum
Bonjour Philippe Tulliez & Bonjour Franc
En définitive j'ai "choisis" la solution de Philippe
Quand j’aurais le temps j'approfondirais la solution de Franc
Il ne faut pas trop en demander à un nonagénaire!!!
Merci à vous deux
Bonne journée
Cordialement