Coloration formes par VBA
Bonsoir LouReeD,
Merci pour ce code pour je voudrais insérer ce code dans le ThisWorkBook sans possibilité de désactiver cette macro.
C'est possible ?
Merci !
J-Baptiste
Ah si si j'ai mis les boutons à gauche mais le fichier que je vous ai envoyé est un exemple
En exemple, voici votre fichier avec l'intégration du plein écran :
Il se met en plein écran à l'ouverture, le bouton se trouve sur la feuille Récap. De mon coté j'ai ajouté des bouton "Retour Sommaire" avec de simple Shapes et un lien hypertexte "dans ce document", pour ce genre de chose cela suffit, plutôt que des boutons types formulaire ou activeX.
@ bientôt
LouReeD
Merci LouReeD pour le code seulement je souhaiterais ne pas pouvoir revenir sur le "petit écran". Par défaut, dès l'ouverture je voudrais que le plein écran soit activé et aussi que le ruban soit masqué.
Comment dois-je adapter ce code ?
Merci à vous !
J-Baptiste
Supprime le bouton qui permet de basculer de l'un à l'autre.
Normalement à l'ouverture cela se met en plein écran (seule la barre de fenêtre reste apparente)
Si le bouton n'existe plus alors "simplement" il n'y a pas de moyen à revenir en arrière si ce n'est le [CTRL]+[F1] je crois.
@ bientôt
LouReeD
Re LouReeD,
J'ai essayé de supprimer le bouton avant de lancer la macro mais malheureusement ça plante, j'ai un code erreur. On ne peut pas simplifier le code en évitant le mode "Petit écran" / "Plein écran" ?
J'ai essayé de modifier le code qui est dans le module mais ça ne fonctionne pas donc je reviens vers vous...
Je voudrais juste que le code me donne accès qu'à la fenêtre Windows et les barres de défilement, rien d'autre
De nouveau, merci
J-Baptiste
Bonjour LouReeD,
C'est bon j'ai réussi à me débrouiller ! Par contre autre question, j'aurais aimé intégrer mon userform "barre de progression" lors de l’exécution de la macro "Init". Je ne sais pas quoi mettre à la place des "++++++++++++++++++". Pourriez-vous m'aider svp ?
Voici la macro:
Sub Int_Classeur()
'********************************************************************
barreProgression.afficher
'********************************************************************
Dim Plage As Range, Cel_Trouv As Range, DerLig As Long, I, Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
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
Saut:
'**************************************************************************************
barreProgression.actualiser CInt((+++++++++++++++++++++++++++++++++++++++++++++) * 100)
'*************************************************************************************
End If
End With
End If
Next Sh
End SubMerci à vous pour votre aide !
J-Baptiste
Bonjour,
tu devrais faire une 1ère boucle sur tes feuilles juste pour faire la somme de tes derlig.
Et dans ta boucle actuelle tu sais à quelle ligne tu en es, + les lignes des autres feuilles déjà traitées.
Comme ça tu sais où tu en es sur le total pour la progression.
Tu pourrais commencer par mettre screenupdating=false pour voir si visualiser la progression est est vraiment justifié. Si ça met moins de qq secondes oublie.
eric
Bonjour Eric,
C'est gentil de vous intéresser à mon problème ! Je débute en VBA donc je ne sais pas comment faire cela ?
Vous pourriez me donner un exemple de code svp ?
Après je me débrouillerai pour le Userform
Merci à vous !
J-Baptiste
ne pas faire les choses à l'envers...
Avant de vouloir faire patienter les gens, se poser la question de pourquoi est-ce long ? Et est-ce qu'on peut y remédier ?
Si tu revois toutes les feuilles alors qu'une seule cellule a changé c'est une erreur.
Perso, tant que tu n'auras pas expliqué un peu plus ton fichier, son fonctionnement et comment tu l'utilises je n'irais pas plus loin.
D'autant plus que tu n'as pas dit ce que ça donnait avec screenupdating=false. Tu passes de combien de s à combien de s ?
eric
Re Eric !
Tu as raison, je vais donner plus d'explications ! En fait cette macro va me permettre d'effacer environ 60% d'une feuille automatiquement plutôt que de le faire à la main. En tout j'ai 52 feuilles et l'opération est identique sur toutes les feuilles.
Le but étant bien de passer sur toutes les feuilles qui commencent par "V".
Je n'ai pas essayé la fonction "screenupdating=false" car je ne sais pas ce que c'est ni où la placer
Merci pour ton analyse !
J-Baptiste
Bonsoir,
le code en soit est rapide (à moins qu'il y ait beaucoup de feuille) mais je crois plus que c'est pour donner une apparence "pro" à l'application...
@ bientôt
LouReeD
Bonsoir LouReeD,
Il doit durer une dizaine de secondes environ. J'ai une cinquantaine de feuilles...
Merci
J-Baptiste
Il n'est pas possible d'adapter un USERFORM du coup ? C'est juste pour éviter que mes collaborateurs ne voient le rond Windows tourner en pensant que le classeur est planté...
Si c'est de mettre les feuilles en plein écran qui prend du temps, si vous ne voulez pas repasser en "petit" écran, alors il est inutile de lancer le code à chaque ouverture, je crois que le fichier Excel garde ses caractéristiques lors de sa fermeture.
Donc grand écran et enregistrement et ça reste comme cela, mais j'en suis pas sur...
@ bientôt
LouReeD
Re LouReeD,
Le code donné juste avant ne sera pas exécuté au démarrage du classeur mais depuis un bouton "shape" de temps en temps.
J'ai trouvé la réponse pour le mode plein écran au démarrage du classeur
C'est le code ci-dessous que j'aurais aimé faire fonctionner depuis un bouton en lançant un USERFORM en même temps
Le souci c'est que je ne sais pas quoi mettre à la place des "+++++++++"
Sub Int_Classeur()
'********************************************************************
barreProgression.afficher
'********************************************************************
Dim Plage As Range, Cel_Trouv As Range, DerLig As Long, I, Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
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
Saut:
'**************************************************************************************
barreProgression.actualiser CInt((+++++++++++++++++++++++++++++++++++++++++++++) * 100)
'*************************************************************************************
End If
End With
End If
Next Sh
End SubMerci !
J-Baptiste
met déjà en 1ère ligne (après les déclarations) :
Application.ScreenUpdating= Falseet vois si ça vaut toujours le coup.
Pas dit que ça change grand chose puisque les autres feuilles ne sont pas activées, mais c'est à tester en 1er
eric
Bonsoir Eric,
Merci pour ton aide mais je ne vois pas où insérer cette ligne de code exactement, peux-tu m'éclairer ?
Merci à toi
suite...
en 1ère ligne (après les déclarations)
Si on parle le même français tu devrais y arriver
Comme loureed annonce que c'est rapide, tu peux te contenter de compter les feuilles :
Au début :
Dim nbSh As Long
Tout à la fin :
'~~~~~~~~~~~~~~~~~~~~~
nbSh = nbSh + 1
Debug.Print Round(nbSh / Worksheets.Count, 0)
'~~~~~~~~~~~~~~~~~~~~~~~~
Next Sh
End SubJ'affiche dans la fenêtre d'exécution de vbe, toi tu t'en sers pour modifier ton contrôle.
eric
Comme ceci:
Sub Int_Classeur()
Application.ScreenUpdating= False
'********************************************************************
barreProgression.afficher
'********************************************************************
Dim Plage As Range, Cel_Trouv As Range, DerLig As Long, I, Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
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
Saut:
'**************************************************************************************
barreProgression.actualiser CInt((+++++++++++++++++++++++++++++++++++++++++++++) * 100)
'*************************************************************************************
End If
End With
End If
Next Sh
End Sub