XL 2016 Cacher ou (dé)cacher lignes dans plusieurs feuilles automatiquement

chingilou

XLDnaute Junior
bonjour les exceleurs
j'ai quatre feuilles acceuil ; hanifatoys ; ATERNAL et Arba (des factures quoi)
tout mon travail ce fait de la 1ere feuille "accueil" quand je remplis mon tableau je voudrais que les lignes vides [B10:B195] (vérification dans cellule B) seront cacher dans les 3 autres feuilles automatiquement sans bouton et surtout vu la quantité sans lenteur si possible
les coordonnées des tableaux des 3 feuilles ne se correspondent pas
[B10:B195] de accueil correspond à [D22:207]] hanifatoys ; [B13:B198] ATERNAL et [B19:B205] Arba
et Merci
 

Pièces jointes

  • 01.xlsx
    64 KB · Affichages: 16

chingilou

XLDnaute Junior
ça s'est réglé en ajoutant Application.ScreenUpdating = False
pour client j'en ai une quinzaine pour le moment
rendre paramétrable la macro ça sera extraordinaire
exemple
Sub print1()
Application.ScreenUpdating = False
Sheets("xxxxxx").Activate ' Selection feuille pour mise à jour
Worksheets("xxxxxxx").PrintPreview
Sheets("Acceuil").Activate ' Retour page d'acceuil
End Sub
sur 3 boutons
pour les 3 feuilles au lieu de 3 copies de cette macro
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
En PJ un essai où tout est simplifié.
Dans chaque feuille "client mettre ces 3 lignes toujours identiques :
VB:
Sub Worksheet_Activate()
    UpdateSheet
End Sub
Tout est traité dans UpdateSheet. C'est la même macro qu'avant mais on commence par rechercher les infos en automatique : Nb ligne à copier, Début et Fin du tableau, Nom du client.
Code:
Sub UpdateSheet()
    Dim NbLig%, NoCol%, Deb%, Fin%, Nom$, L%
    On Error GoTo Erreur
    Application.ScreenUpdating = False                                      ' Figer écran
' Détermination de paramètres
    NbLig = Application.CountIf(Sheets("Acceuil").Range("A10:A196"), ">0")  ' Nombre de lignes à récuperer
    Nom = ActiveSheet.Name                                                  ' Nom de la feuille active
    NoCol = Application.Match(Nom, Sheets("Acceuil").[9:9], 0)              ' N° de colonne à récupérer dans Acceuil
    Deb = Application.Match("*quantité*", [D:D], 0) + 1                     ' Début du tableau où ranger
    Fin = Application.Match("*TOTAL HT*", [D:D], 0) - 1                     ' Fin du tableau
' Préparation feuille
    Rows(Deb & ":" & Fin).Hidden = False                                    ' Toutes lignes démasquées
    Range("A" & Deb & ":E" & Fin).ClearContents                             ' Effacement tableau
' Récupération infos
    With Sheets("Acceuil")
        Range("A" & Deb & ":B" & Deb + NbLig) = .Range("A10:B" & 10 + NbLig).Value  ' Copier Coller valeurs Ref et Des.
        Range("D" & Deb & ":D" & Deb + NbLig) = .Range("C10:C" & 10 + NbLig).Value  ' Copier Qté
        ' Transfert données client de la bonne colonne
        Range("C" & Deb & ":C" & Deb + NbLig) = .Range(.Cells(10, NoCol), .Cells(10 + NbLig, NoCol)).Value
' Calcul et masquage lignes
        For L = Deb To Deb + NbLig
            Cells(L, "E") = Cells(L, "C") * Cells(L, "D")                           ' Calcul montant TTC
        Next L
        Rows(Deb + NbLig & ":" & Fin).Hidden = True                                 ' Masque les lignes vides.
    End With
Exit Sub
Erreur:
    MsgBox "Une erreur est intervenue." & Chr(10) & "Vérifiez vos données et leur emplacement."
End Sub
Cela suppose trois choses :
1- En ligne 9 de Accueil les noms sont strictement les mêmes que les noms de feuilles
2- Dans les feuilles en colonne D, on doit trouver strictement les mots Quantité et TOTAL HT.
3- Le dessin d'imprimante doit porter strictement le même nom que le client.

Tant qu'à faire pour l'impression j'ai fait la même chose, un seul module, l'explication est dans le code.
Par Application.Caller on récupère quel bouton a appelé, on en déduit la feuille à traiter. Et donc tous les boutons appellent la même macro ImpressionFeuille.
Code:
Sub ImpressionFeuille()
    Dim Nom$
    On Error GoTo ErreurImp
    Nom = Application.Caller            ' Qui donc m'a appellé ?
    Sheets(Nom).Activate                ' Selection feuille pour mise à jour
    Worksheets(Nom).PrintPreview        ' Visualisation impression
    Sheets("Acceuil").Activate          ' Retour page d'acceuil
Exit Sub
ErreurImp:
    MsgBox "Une erreur est survenue." & Chr(10) & "Vérifier bien qu'il y a le mêm nom pour :" & Chr(10) & _
            "- Le nom du dessin" & Chr(10) & _
            "- Le nom présent en ligne 9 de Accueil" & Chr(10) & _
            "- Le nom de la feuille correspondante."

End Sub

De cette façon, on ne touche plus au code quand on rajoute un client. Il n'y a plus aucune formule superflue. La rapidité est maximale.

A tester.
 

Pièces jointes

  • Chingilou 5.xlsm
    57.2 KB · Affichages: 4

job75

XLDnaute Barbatruc
Ma solution n'a pas l'air de vous passionner...

Alors avec des raccourcis clavier au lieu d'un bouton dans ce fichier (2) :
VB:
Sub Masquer()
'se lance par Ctrl+M
Dim a, b, i%, w As Worksheet
a = Array("Accueil", "Hanifatoys1", "ATERNAL", "Arba") 'noms des feuilles à traiter
b = Array(10, 22, 13, 18) '1ères lignes à étudier
For i = 0 To UBound(a)
    Set w = Sheets(a(i))
    With w.Rows(b(i) & ":" & w.Rows.Count)
        .Hidden = False
        On Error Resume Next 'si aucune SpecialCell
        Intersect(w.Range("A" & b(i)).CurrentRegion.Columns(1), .Cells) _
            .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True
    End With
Next
End Sub

Sub Tout_Afficher()
'se lance par Ctrl+T
Dim w As Worksheet
For Each w In Sheets(Array("Accueil", "Hanifatoys1", "ATERNAL", "Arba")) 'liste des feuilles à traiter
    w.Rows.Hidden = False
Next
End Sub
 

Pièces jointes

  • 01(2).xlsm
    74.5 KB · Affichages: 5

chingilou

XLDnaute Junior
rebonjour mes amis et encore merci pour toutes ces idées
l'idée d'utiliser SOMMEPROD() est une révélation pour moi
et je me débarrasse de pas mal de formules donc optimisation du classeur

sylvanu

les clients c'est dans D4
hanifatoys;aternal et arba c'est des vendeurs/importateurs
donc pour les logos imprimantes j'ajoute seulement une colonne pour facture finale
je sauvegarde les 3 feuilles grace à
Sub savexlsx()
chemin = ThisWorkbook.Path & "\Proforma\"
Fname = Sheets("Acceuil").Range("D4").Value & Format(Now(), "-dd" & "-mmmm" & "-yyyy-") & Format(ActiveSheet.Range("D7"), "0000") & extension
Sheets(Array("Hanifatoys1", "Aternal", "Arba")).Copy
For Each ws In ActiveWorkbook.Worksheets
With ws.UsedRange
.Value = .Value
End With
Next ws
With ActiveWorkbook
.SaveAs Filename:=chemin & Fname
.Close
End With
End Sub

mais j'aurais aimé en plus sauvegardé ces données dans un tableau ainsi je pourrais revoir ces proforma s aisément sans chercher dans mon dossier proforma
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Chingilou,
Avant de formuler une nouvelle demande, dites moi si l'approche du post #17 est correct.
La feuille visualisation imprimante correspond à la colonne où il y a les données.
Pour la sauvegarde dans un tableau, est ce que ce sera une nouvelle feuille ? Doit on sauvegarder les trois colonnes, référencées avec les N° de factures présentes en ligne 7 ?
 

chingilou

XLDnaute Junior
bonjour sylvanu
oui l'approche est très correcte c'est vrai je n'étais pas très emballé par l'effacement des formules dans les 3 feuilles mais comme j'ai dis je connaissais pas (a vrai dire j'ai oublié) SOMMEPROD()
j'ai même une autre feuille si tu permet qui calcule ce que j'appelle une facture inversée on donne 1-total ttc 2-les articles+qt+prix unitaires ca me change les prix unitaires pour correspondre au total ttc donné j'envois la feuille ou dois-je faire un nouveau post ???
pour la sauvegarde oui regarde la macro dans un dossier qui dois existé "proforma" les 3 feuilles tel quel biensur "sans macro" maintenant allégé de formules ca sera plus simple
 

Statistiques des forums

Discussions
315 149
Messages
2 116 778
Membres
112 859
dernier inscrit
patricekangourou