Développement et modification macro
Bonjour,
Après prés d'une semaine d'utilisation, je me permets d’écrire un message pour vous donner mon ressenti.
Je suis vraiment ravi, j'ai utilisé le fichier Excel quasi toute la semaine, et pour l'instant aucun bug, aucun souci.
Je voulais donc vous remercier énormément, pour le travail accompli je ne serais comment vous remercier.
Bonne journée à vous.
Binjour,
Bien sûr que vous savez comment me / nous remercier ! Vous venez de le faire avec ce retour !
Merci @vous pour vos remerciements !
@ bientôt
LouReeD
Je vous en prit c'est la moindre des choses.
Cordialement Vivien
Bonjour,
J'ai une petite question ?
Je peux grâce au bouton Imprimer le plan de construction, imprimer le plan de ce que je dois faire en réel.
Excel me dit alors que sur la 1er ligne il y a XX de rouge, puis XX de Jaune, ainsi de suite sur les lignes suivantes.
Je voudrais savoir si à partir d'un fichier Excel je peux isoler la macro qui me sert à faire sa et ensuite lui ajouter 2 options.
- la 1er option serait de faire ce plan mais en groupant les tas sur chaque ligne.
Je m'explique si je donne à Excel le nombre 10, il va faire en sorte de me calculer de 10 en 10, (10 rouges, ou 5 rouges 5 jaunes...,). si je ne suis pas clair je peux mieux vous expliquer bien sur. J'ai pris 10 par exemple mais ça peut très bien être 20 ou 30, il faudrait que j'ai le choix de donner à Excel un chiffre entre 0 et 100, pour qu'ensuite il me fasse le plan.
- la 2eme option serait de retourner mon dessin de 180°c, comme sur la photo ci jointe.
Ou alors d'avoir une option pour choisir si le plan commence a la ligne n°1 ou a la dernière ligne de mon dessin, le plan serait ainsi construit à l’envers.
Cordialement Vivi
Bonsoir,
pour identifier un code par rapport à l'action d'un bouton, il suffit de faire un clic droit sur ce bouton et de choisir "affecter une macro", vous voyez alors quelle est la procédure utilisée.
Une fois ceci fait, vous pouvez mettre un point d'arrêt au code (clic gauche sur la marge gauche de la fenêtre de code = un rond rouge apparaît au regard de la ligne choisie) puis avec la touche F8 vous déroulez le code ligne par ligne et vous pouvez voir ce qui se passe à l'écran sur le classeur.
Du coup votre procédure à quatre grandes parties :
la première sert à demander un nom pour la feuille de sortie (Attention ! Il n'y a pas de test de redondance de nom, du coup cela provoque une erreur)
la deuxième sert à identifier le nom des différentes lignes, dans votre exemple de fresque il y a 16 lignes donc sur la feuille de sortie il y aura ligne 1 à ligne 16 d'inscrit en colonne A à partir de la ligne 1 jusqu'à la 16.
la troisième partie compte les cellules contigües de même couleur par ligne, dans votre cas cela donnera 20 sur fond rouge et 20 sur fond jaune et ce sur 8 lignes puis 20 sur fond vert, et 20 sur fond bleu et ce sur 8 lignes également.
la quatrième partie permet de mettre "du contraste" du nombre de couleur en fonction de la couleur de fond => fond jaune la police reste en noir sur fond bleu la police passe en blanc.
Maintenant qu'on a le fonctionnement de principe de la procédure, le point 1 que vous avancez serait-il celui-ci :
Si vous indiquez des tas de "7" alors la macros toujours avec le même exemple, ne doit pas faire un tas de 20 rouge et 20 jaune mais devrait faire un tas de 7 rouge, puis un tas de 3 rouge et 4 jaune, puis un tas de 6 jaune ?
Pour le point numéro 2 il suffit de faire "tourner" les boucles dans le "bon sens" afin que la décalage s'opère. Mais votre exemple n'est pas une rotation à 180 °!
pour le bleu OK, pour le vert OK, mais Aïe ! le rouge et jaune n'ont pas bougés !
Mais j'ai du mal à saisir le point 1 si vous pouvez donner des explications ? Avec des informations du type "il faut que" par exemple vous parlez de pouvoir donner un chiffre entre 1 et 100 mais vous ne donnez en exemple que des multiples de 10.
@ bientôt
LouReeD
Votre code avec la rotation à 180° :
Sub FieldBlueprint()
Dim FieldName As String, Rows As Integer, Columns As Integer, i As Integer, j As Integer, P As Integer, k As Integer, L As Integer, CurrentCell As Range, PreviousCell As Range, CurrentCellColor As Integer, PreviousCellColor As Integer
If IsNumeric(UserForm1.TextBox1.Value) And IsNumeric(UserForm1.TextBox2.Value) And UserForm1.TextBox1.Value > 0 And UserForm1.TextBox2.Value > 0 Then
Rows = UserForm1.TextBox1.Value
Columns = UserForm1.TextBox2.Value
FieldName = Application.InputBox("Entreer un nom pour cette fresque")
If FieldName <> "" Then
ActiveWorkbook.Sheets.Add(After:=Worksheets("Plan Au Sol")).Name = FieldName
Sheets(FieldName).Cells.ColumnWidth = 8.11 / 2
Sheets(FieldName).Range("a1").ColumnWidth = 8.11
' aafichage du numéro des différentes lignes
For i = 1 To Rows
With Sheets(FieldName).Cells(i, 1)
.Value = "Ligne " & i
.Font.Bold = True
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
Next i
number = 1
k = 0
L = 0
' calcul du nombre de cellules contigües de même couleur
' ici on boucle à l'envers en colonne et en ligne du coup on a une rotation de 180°
For i = Rows - 1 To 0 Step -1
For j = Columns - 1 To 0 Step -1
Set CurrentCell = Sheets(2).Cells(1, 27).Offset(i, j)
Set PreviousCell = Sheets(2).Cells(1, 27).Offset(i, j + 1)
CurrentCellColor = CurrentCell.Cells.Interior.ColorIndex
PreviousCellColor = PreviousCell.Cells.Interior.ColorIndex
If CurrentCellColor = PreviousCellColor Then
number = number + 1
ElseIf CurrentCellColor <> PreviousCellColor Then
With Sheets(FieldName).Cells(1, 2).Offset(k, L)
.Interior.ColorIndex = PreviousCellColor
.Value = number
.Borders(xlEdgeLeft).LineStyle = xlDot
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeBottom).LineStyle = xlDot
.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideHorizontal).LineStyle = xlDot
End With
number = 1
L = L + 1
End If
Next j
With Sheets(FieldName).Cells(1, 2).Offset(k, L)
.Interior.ColorIndex = CurrentCellColor
.Value = number
.Borders(xlEdgeLeft).LineStyle = xlDot
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeBottom).LineStyle = xlDot
.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideHorizontal).LineStyle = xlDot
End With
k = k + 1
L = 0
number = 1
Next i
' mise en 'contraste des valeurs des cellules
For i = 0 To Rows - 1
P = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For j = 0 To P
Set CurrentCell = Range("a1").Offset(i, j)
If CurrentCell.Interior.ColorIndex = 1 Or CurrentCell.Interior.ColorIndex = 3 Or CurrentCell.Interior.ColorIndex = 5 Or CurrentCell.Interior.ColorIndex = 9 Or CurrentCell.Interior.ColorIndex = 10 Or CurrentCell.Interior.ColorIndex = 11 Or CurrentCell.Interior.ColorIndex = 12 Or CurrentCell.Interior.ColorIndex = 13 Or CurrentCell.Interior.ColorIndex = 14 Or CurrentCell.Interior.ColorIndex = 16 Or CurrentCell.Interior.ColorIndex = 18 Or CurrentCell.Interior.ColorIndex = 21 Or CurrentCell.Interior.ColorIndex = 23 Or CurrentCell.Interior.ColorIndex = 25 Or CurrentCell.Interior.ColorIndex = 29 Or CurrentCell.Interior.ColorIndex = 30 Or CurrentCell.Interior.ColorIndex = 31 Or CurrentCell.Interior.ColorIndex = 32 Or CurrentCell.Interior.ColorIndex = 41 Or CurrentCell.Interior.ColorIndex = 47 Or CurrentCell.Interior.ColorIndex = 48 Or CurrentCell.Interior.ColorIndex = 49 Or CurrentCell.Interior.ColorIndex = 50 Or CurrentCell.Interior.ColorIndex = 51 Or CurrentCell.Interior.ColorIndex = 52 _
Or CurrentCell.Interior.ColorIndex = 53 Or CurrentCell.Interior.ColorIndex = 54 Or CurrentCell.Interior.ColorIndex = 55 Or CurrentCell.Interior.ColorIndex = 56 Then
CurrentCell.Font.ColorIndex = 2
End If
Next j
Next i
UserForm4.Show vbModeless
End If
Else
MsgBox "Erreur: Utiliser 'Redimensioner La Fresque' pour sélectionner la taille de votre fresque"
End If
End SubReste à comprendre l'histoire des "tas"...
La ligne de test pour le contraste pourrait être simplifièe je pense...
@ bientôt
LouReeD
Bonsoir,
le code modifié pour faire des tas de x cartes :
Sub FieldBlueprint()
Dim FieldName As String, Rows As Integer, Columns As Integer, i As Integer, j As Integer, P As Integer, k As Integer, L As Integer, CurrentCell As Range, PreviousCell As Range, CurrentCellColor As Integer, PreviousCellColor As Integer
Dim CarteduTas, Tas
If IsNumeric(UserForm1.TextBox1.Value) And IsNumeric(UserForm1.TextBox2.Value) And UserForm1.TextBox1.Value > 0 And UserForm1.TextBox2.Value > 0 Then
Rows = UserForm1.TextBox1.Value
Columns = UserForm1.TextBox2.Value
FieldName = Application.InputBox("Entreer un nom pour cette fresque")
If FieldName <> "" Then
ActiveWorkbook.Sheets.Add(After:=Worksheets("Plan Au Sol")).Name = FieldName
Sheets(FieldName).Cells.ColumnWidth = 8.11 / 2
Sheets(FieldName).Range("a1").ColumnWidth = 8.11
' affichage du numéro des différentes lignes
For i = 1 To Rows
With Sheets(FieldName).Cells(i, 1)
.Value = "Ligne " & i
.Font.Bold = True
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
Next i
number = 1
k = 0
L = 0
' calcul du nombre de cellules contigües de même couleur
' ici on boucle à l'envers en colonne et en ligne du coup on a une rotation de 180°
Tas = Application.InputBox("Valeur du tas") * 1
CarteduTas = 1
For i = Rows - 1 To 0 Step -1
For j = Columns - 1 To 0 Step -1
Set CurrentCell = Sheets(2).Cells(1, 27).Offset(i, j)
Set PreviousCell = Sheets(2).Cells(1, 27).Offset(i, j - 1)
CurrentCellColor = CurrentCell.Cells.Interior.ColorIndex
PreviousCellColor = PreviousCell.Cells.Interior.ColorIndex
If CurrentCellColor = PreviousCellColor Then
number = number + 1
CarteduTas = CarteduTas + 1
ElseIf CurrentCellColor <> PreviousCellColor Then
With Sheets(FieldName).Cells(1, 2).Offset(k, L)
.Interior.ColorIndex = CurrentCellColor
.Value = number
.Borders(xlEdgeLeft).LineStyle = xlDot
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeBottom).LineStyle = xlDot
.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideHorizontal).LineStyle = xlDot
End With
number = 1
L = L + 1
CarteduTas = 1
'j = j - 1
End If
If CarteduTas = Tas Then
With Sheets(FieldName).Cells(1, 2).Offset(k, L)
.Interior.ColorIndex = PreviousCellColor
.Value = number
.Borders(xlEdgeLeft).LineStyle = xlDot
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeBottom).LineStyle = xlDot
.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideHorizontal).LineStyle = xlDot
End With
number = 1
L = L + 1
CarteduTas = 1
j = j - 1
End If
Next j
k = k + 1
L = 0
number = 1
CarteduTas = 1
j = j - 1
Next i
' mise en 'contraste des valeurs des cellules
For i = 0 To Rows - 1
P = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For j = 0 To P
Set CurrentCell = Range("a1").Offset(i, j)
If CurrentCell.Interior.ColorIndex = 1 Or CurrentCell.Interior.ColorIndex = 3 Or CurrentCell.Interior.ColorIndex = 5 Or CurrentCell.Interior.ColorIndex = 9 Or CurrentCell.Interior.ColorIndex = 10 Or CurrentCell.Interior.ColorIndex = 11 Or CurrentCell.Interior.ColorIndex = 12 Or CurrentCell.Interior.ColorIndex = 13 Or CurrentCell.Interior.ColorIndex = 14 Or CurrentCell.Interior.ColorIndex = 16 Or CurrentCell.Interior.ColorIndex = 18 Or CurrentCell.Interior.ColorIndex = 21 Or CurrentCell.Interior.ColorIndex = 23 Or CurrentCell.Interior.ColorIndex = 25 Or CurrentCell.Interior.ColorIndex = 29 Or CurrentCell.Interior.ColorIndex = 30 Or CurrentCell.Interior.ColorIndex = 31 Or CurrentCell.Interior.ColorIndex = 32 Or CurrentCell.Interior.ColorIndex = 41 Or CurrentCell.Interior.ColorIndex = 47 Or CurrentCell.Interior.ColorIndex = 48 Or CurrentCell.Interior.ColorIndex = 49 Or CurrentCell.Interior.ColorIndex = 50 Or CurrentCell.Interior.ColorIndex = 51 Or CurrentCell.Interior.ColorIndex = 52 _
Or CurrentCell.Interior.ColorIndex = 53 Or CurrentCell.Interior.ColorIndex = 54 Or CurrentCell.Interior.ColorIndex = 55 Or CurrentCell.Interior.ColorIndex = 56 Then
CurrentCell.Font.ColorIndex = 2
End If
Next j
Next i
UserForm4.Show vbModeless
End If
Else
MsgBox "Erreur: Utiliser 'Redimensioner La Fresque' pour sélectionner la taille de votre fresque"
End If
End Subavec ce résultat dans votre exemple et un choix de 3 pour les tas et pour la première ligne : 3 bleu, 3 bleu, 3 bleu, 3 bleu, 3 bleu, 3 bleu, 2 bleu (car il n'y a pas assez de bleu pour faire trois), 3 vert, 3 vert, 3 vert, 3 vert, 3 vert, 3 vert et 2 vert (pour la même raison).
C'est le résultat de ce que j'ai compris, et comme vous le voyez il y a bien rotation des couleurs de 180°.
@ bientôt
LouReeD
Bonsoir,
Pour le point numéro 2 il suffit de faire "tourner" les boucles dans le "bon sens" afin que la décalage s'opère. Mais votre exemple n'est pas une rotation à 180 °!
pour le bleu OK, pour le vert OK, mais Aïe ! le rouge et jaune n'ont pas bougés !
En effet vous avez totalement raison, je me suis complètement trompé.
Voici l'image avec une bonne rotation à 180°C.
Mais j'ai du mal à saisir le point 1 si vous pouvez donner des explications ? Avec des informations du type "il faut que" par exemple vous parlez de pouvoir donner un chiffre entre 1 et 100 mais vous ne donnez en exemple que des multiples de 10.
Alors voici un peu plus de détail .
Pour les explications je me suis basé sur ce dessin :
Si je donne à Excel le chiffre 6, et que je prends la ligne ci-dessus comme exemple Excel devra me dire :
Ligne 1 : 6 Jaunes/ 3 bleus, 3verts/ 2bleus,2verts,2bleus/ 6verts / 3 rouges,3 jaunes/ 5 rouges (car il n'y a pas assez de case pour faire 6).
En fait Excel doit calculer au sein de ma fresque de 6 en 6, (ou de X en X, si X est remplacé par un chiffre entre 10 et 100).
Et me donner le nombre de couleurs dans cet intervalle de 6 (ou de X) d’où le détail ci-dessus?.
Voici un exemple avec un fichier Excel dont je m'inspire.
La fresque :
Le détail :
Si ce n'est pas clair je peut vous ré-expliquer sans soucis.
Vivi
Bonjour,
veuillez trouver ci joint un code "épuré" par rapport à votre fichier :
Il fait ce que vous demandez sauf le "rebours", c'est juste un test afin de savoir s'il faut continuer dans ce sens.
La variable "Tas" est à modifier directement dans le code afin de faire varier les tests, mais de mon coté cela semble concluant.
Restera à mettre les différentes valeurs en variable, à faire tourner les boucle à rebours ou pas en fonction des différents choix qui seront proposés à l'utilisateur et surtout à l'intégrer dans votre fichier d'origine en reprenant le noms de vos variables afin de garder une certaine homogénéité dans l'application.
Il est évident également que le type de chaque bordures pourra évoluer, ici j'ai pris "vos pointillés" pour la séparation des couleur dans un même tas et le trait épais et continu pour la séparations des différents tas.
@ bientôt
LouReeD
Bonjour,
Je viens de faire plusieurs tests, en effet cela fonctionne très bien.
J'ai bien repéré la ligne de code à modifier afin de modifier le nombre de couleurs dans le tas.
Il est évident également que le type de chaque bordures pourra évoluer, ici j'ai pris "vos pointillés" pour la séparation des couleur dans un même tas et le trait épais et continu pour la séparations des différents tas.
Vous avez très bien fait je trouve cela encore plus lisible, que sur la photo que je vous avais envoyé.
Afin d'avoir plus de lisibilité je pense qu'il serait judicieux, d'ajouter 2 boutons dans le fichier de base.
Un pour générer un tas de X pièces.
Et l'autre pour faire retourner la fresque ou non, afin que de ne pas avoir à rentrer dans le code à chaque fois .
Très beau travail en tout cas.
Cordialement Vivi
Bonsoir,
j'avoue j'ai essayé mais point réussi à intégrer le code à votre fichier, je suis perdu dans la manière de faire les tests de couleurs entre cellule d'avant et cellule en cours... Je trouve plus simple de faire le test de la cellule en cours avec une couleur mise en mémoire.
Du coup faudrait presque tout ré écrire... Vous sentez vous capable de faire cette intégration ou ré écriture ? Dites le moi, et à "mes heures perdues" je me plongerai dedans
Une question : vous faites dans l'événementiel ? Ou bien c'est pour de la pub ? Pour faire des surprises lors d'anniversaire ? Je dis cela car des fresques avec des "pose le !"...
@ bientôt
LouReeD
Bonsoir,
pour essayer de changer la fin du code qui permet un meilleur contraste du texte en fonction de la couleur de fond de la cellule, il y a sur le net une formule qui dit :
SI ((Red value X 299) + (Green value X 587) + (Blue value X 114)) / 1000 < 125 ALORS AFFICHER DU BLANC (#FFF) SINON du NOIR (#000)
Pour récupérer les valeur rouge, vert et bleu d'une couleur au format "long" récupérée avec Interior.Color il faut faire ceci :
Rouge = Int(Couleur Mod 256)
Vert = Int((Couleur Mod 65536) / 256)
Bleu = Int(Couleur / 65536)
@ bientôt
LouReeD
Bonjour,
Alors je veut bien essayer d’intégrer, cette macro mais je ne suis pas sur d'y arriver. Je vais faire deux, trois tentatives.
Cordialement Vivi
Bonjour,
sinon ci joint "la correction" que je vous propose :
Attention ! J'ai supprimer deux feuilles : planificateur de mur et je ne sais plus car le fichier était trop lourd !
Sinon ajout d'un USFLRD pour le choix de l'opération avec indication du nom de la feuille de sortie, de la rotation ou pas du tableau de sortie et du nombre de pièce par tas (si pas d'indication alors = 5)
Ajout d'un module FieldBluprintLouReeD où il y a l'adaptation du code du fichier test.
@ bientôt
LouReeD
Re,
Je viens de le tester, aucun souci pour avoir supprimé les onglets, je possède l'original donc pas de soucis.
J'ai fait plusieurs tests, et c'est super rien à dire.
J'ai juste un petit souci si je ne rentre pas de quantité il me donne un message d’erreur et si je clique sur débloquer voici le problème :
Cordialement Vivi
Il faut je pense faire le test dans l'autre sens :
Tas = IIf(TextBox2. Value ="", 5,CDbl(Textbox2.Value))
A voir... Mais normalement il doit y avoir une valeur, non ?
Si cette correction ne marche pas alors dans l'initialisation du USF il suffira de mettre 5 par defaut et supprimer les test :
Init => TextBox2. Value = 5
Bouton Valider => Tas = CDbl(TextBox2. Value)
Je suis sur téléphone donc pas testé...
@ bientôt
LouReeD
Je viens de tester cela :
Tas = IIf(TextBox2. Value ="", 5,CDbl(Textbox2.Value))
Cela ne fonctionne pas non plus.
A voir... Mais normalement il doit y avoir une valeur, non ?
Il doit y avoir une valeur où,.
Vivi
Bonsoir,
avec un ordi c'est mieux !
Mettez ceci : If TextBox2.Value = "" Then Tas = 5 Else Tas = TextBox2.Value * 1
à la place du Tas=IIf.....
@ bientôt
LouReeD
Bonjour,
Je viens de faire la modification, comme vous me l'avez donné sur le précédent post.
Et c'est parfait ça fonctionne du tonner.
Merci a vous, bonne journée et bon week-end
Vivi
Bonsoir,
Merci pour vos remerciements ! Et bonne mosaïques à vous !
@ bientôt
LouReeD