Coloration formes par VBA

Bon, j'arrive un peu tard :

Sub Int_Classeur()
 Application.ScreenUpdating = False
    '********************************************************************
    barreProgression.afficher
    '********************************************************************
    Dim Plage As Range, Cel_Trouv As Range, DerLig As Long, I, Sh As Worksheet, Nb_Feuille, Cpt
    Nb_Feuille = ThisWorkbook.Worksheets.Count
    For Each Sh In ThisWorkbook.Worksheets
        Cpt = Cpt + 1
        If Left(Sh.Name, 1) = "V" Then
            With Sh
                ' on efface les deux première zone et leur colueur
                .Range("F3:I5,J3:M5").ClearContents
                .Range("F3:I5,J3:M5").Interior.Color = xlNone
                ' on attribue à la variable Plage la colonne A de la feuille que l'on essaie de quitter
                Set Plage = .Columns(1)
                ' on attribue la variable Cel_Trouv la cellule qui contient le mot "fin"
                Set Cel_Trouv = Plage.Cells.Find("fin", lookat:=xlWhole)
                ' si cette cellule est vide on quitte la procédure de test car "fin" n'a pas été trouvé
                If Not Cel_Trouv Is Nothing Then
                    DerLig = Cel_Trouv.Row - 1
                    ' on supprime la couleur des cellules en colonne 1 et 2
                    For I = 9 To DerLig
                        ' on supprime la couleur des cellules en colonne 1 et 2
                        If .Cells(I, 1).MergeArea.Cells.Count = 1 Then .Range("A" & I).Resize(, 2).Interior.Color = xlNone
                        ' on efface les données en colonne D, mais elles sont fusionnées, pour le différencier des autres
                        ' on regarde le nombre de cellules comprise dans la sélection
                        If .Cells(I, 4).MergeArea.Cells.Count = 10 Then .Range("D" & I).Resize(, 10).ClearContents
                        Sheets("Sommaire").Shapes.Range(Sh.Name).Fill.ForeColor.RGB = RGB(255, 0, 0)
                    Next I
                    '**************************************************************************************
                    barreProgression.actualiser CInt((Cpt / Nb_Feuille) * 100)
                    '*************************************************************************************
                End If
            End With
        End If
    Next Sh
End Sub

Voilà, pour que la barre de progression fonction il faut savoir où on en est de la boucle de feuille, d'où la variable compteur Cpt qui s'incrémente de 1 à chaque feuille, et il faut savoir combien de feuille on va boucler, d'où la variable NB_Feuille.

@ bientôt

LouReeD

Re LouReeD,

C'est parfait, merci beaucoup

J-Baptiste

Normalement c'est après les Dim (déclarations) mais ça fonctionnera pareil.

eric

Je n'y connais pas grand chose en VBA mais ça fonctionne comme je voulais, merci à vous deux

Oui normalement on ouvre la Sub, on définie les variables puis on écrit le code.

C'est bien ça ?

Mais bon vous me connaissez, je ne fais rien comme tout le monde...

@ bientôt

LouReeD

Bah, ce n'est pas toi loureed, c'est JBP qui a ajouté une ligne au-dessus des Dim

En fait je ne sais plus !

Mais on va dire que oui, hein JeanBaptisteP !

@ bientôt

LouReeD

Oui oui c'est moi

J'en profite pour vous poser une question concernant l'adaptation de mon classeur à EXCEL.

J'aurais voulu que chaque feuille soit adaptée en largeur à la fenêtre EXCEL. Je pensais placer la macro suivante dans chaque feuille mais en retirant la surbrillance si possible ?

Private Sub Worksheet_Activate()
 Columns("A:M").Select
     ActiveWindow.Zoom = True
 End Sub

Il suffit de mettre ceci ou non ?:

Private Sub Worksheet_Activate()
 Columns("A:M").Select
     ActiveWindow.Zoom = True
     Columns("A:M").Deselect
 End Sub

Merci encore pour votre aide

J-Baptiste

Il n'y a pas de "désélection", pour désélectionner, il faut sélectionner ailleurs...

Donc un simple Range("A1").Select

@ bientôt

LouReeD

D'accord, donc ceci peut fonctionner ?

Private Sub Worksheet_Activate()
 Columns("A:M").Select
     ActiveWindow.Zoom = True
     Range("A1").Select
 End Sub

Merci !

J-Baptiste

Bah, tu testes et tu nous diras

Bonjour Eric,

J'ai rentré ceci comme code et cela fonctionne.

Private Sub Worksheet_Activate()
Dim DerLig As Integer
Dim DerCol As Integer

Range("A1").Select
'DerLig = Range("A" & Rows.Count).End(xlUp).Row
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

Range(Cells(, 1), Cells(, 13)).Select 'à préciser
ActiveWindow.Zoom = True
Application.DisplayFullScreen = True
Range("C5").Select
End Sub

Par contre le souci c'est que j'ai dû rentrer ce code dans chaque feuille alors que je pense que j'aurais pu le rentrer dans le ThisWorkBook. Seul souci c'est que j'ai 3 "modèles" différents.

Voilà ce que j'aurais aimé adapter dans le ThisWorkBook:

- Pour la feuille "Sommaire":

Private Sub Worksheet_Activate()
Dim DerLig As Integer
Dim DerCol As Integer

Range("A1").Select
'DerLig = Range("A" & Rows.Count).End(xlUp).Row
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

Range(Cells(, 1), Cells(, 9)).Select 'à préciser
ActiveWindow.Zoom = True
Application.DisplayFullScreen = True
Range("C5").Select
End Sub

- Pour la feuille "Recap":

Private Sub Worksheet_Activate()
Dim DerLig As Integer
Dim DerCol As Integer

Range("A1").Select
'DerLig = Range("A" & Rows.Count).End(xlUp).Row
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

Range(Cells(, 1), Cells(, 4)).Select 'à préciser
ActiveWindow.Zoom = True
Application.DisplayFullScreen = True
Range("C5").Select
End Sub

- Pour toutes les feuilles qui commencent par "V":

Private Sub Worksheet_Activate()
Dim DerLig As Integer
Dim DerCol As Integer

Range("A1").Select
'DerLig = Range("A" & Rows.Count).End(xlUp).Row
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

Range(Cells(, 1), Cells(, 13)).Select 'à préciser
ActiveWindow.Zoom = True
Application.DisplayFullScreen = True
Range("C5").Select
End Sub

Est-ce que quelqu'un pourrait me venir en aide svp ?

Merci à ceux qui pourront m'aiguiller !

J-Baptiste

Bonjour,

je n'aime pas du tout les applis qui imposent un affichage choisi.

C'est ch...t pour l'utilisateur qui est assez grand pour savoir ce qui lui convient.

Je n'irais pas plus loin, désolé.

eric

Bonjour Eric,

J'ai choisi cela pour rendre la lecture du classeur plus agréable par défaut en l'ajustant à la largeur de l'écran. Après l'utilisateur pourra quand même modifier le Zoom s'il le souhaite.

Pas de souci, je peux comprendre, merci quand même pour votre aide

J-Baptiste

Bonjour JeanBaptisteP,

Tu m'as laissé un MP ce jour mais apparemment ta boîte MP est désactivée. Donc je le laisse en brouillon pour le moment.

Et dès réactivation, je te l'enverrais.

A plus.

Bonsoir,

maintenant vous avez pas mal de code avec des boucles sur les feuilles et les tests qui sont fait pour savoir si c'est une feuille "V" ou pas.

Tous vos tests sont écrit dans votre message...

A vous de trouver la fin...

Et ce code pourra toujours être dans ThisWorkbook, puisqu'il sera au final lancé à chaque activation de feuille.

@ bientôt

LouReeD

Bonsoir LouReeD,

D'accord, je vais essayer de m'en sortir comme ça alors, merci!

Bonne soirée

J-Baptiste

For Each Sh In Worksheets
if Sh.Name = "Récap" Then

ElseIF Sh.Name="Sommaire" Then

ElseIF Left(Sh.Name,1)="V" Then

EndIf

En gros cela pourrait ressembler à ceci.

Le dernier test est peut-être inutile, mais comme cela s'il y a d'autre "type" de feuille elles ne seront pas prises en compte

Et tout ceci dans ThisWorkbook avec la surveillance événementielle Activate.

Mais du coup à chaque activation cela sera lancé... Donc si l'utilisateur change le zoom, en changeant de feuille il devra refaire son changement de zoo... Donc peut-être mieux vaut il le faire à l'ouverture et ma foie l'utilisateur fera ce qu'il veut après...

@ bientôt

LouReeD

Bonjour JeanBaptisteP,

Je reçois bien tes MP. Mais ta boite est vraiment désactivé (restreinte). Donc impossible de lancer le brouillon sauvegardé.

Il est possible de modifier pour ton besoin. Bien que je souhaiterais plus de précisions. Mais surtout le fait que pour tes lignes inscrites A, B, C, etc... elles soient fusionnées de la colonne A à M est gênant. Il serait mieux de les fusionner à partir de la colonne C à M. Cela n'empêche pas de laisser la même couleur bleu sur ces lignes en colonne A à B.

A suivre...

Bonsoir XCellus,

Ah mince ! Je comprends mais mon projet est déjà bien ficelé avec une cinquantaine de pages donc je pense que je vais abandonner cette idée ! LouReeD m'avait proposé une solution aussi en le mettant dans le ThisWorkBook (efficace c'est sûr) mais le souci c'est que ça colorait aussi les chapitres (en bleu ciel) et aussi les commentaires lors du double click ! La solution que tu m'avais donné était parfaite mais je voulais si possible rajouter la possibilité de "décolorer" la case si on refaisait un double click dessus! Mais laissons tomber si c'est complexe à mettre en oeuvre !

Pour info, je poste la macro que LouReeD avait proposé.

Merci à vous tous!

J-Baptiste