Code VBA - bordure bas
Bonjour forum,
J'ai une macro existante. Et je cherche svp un code vba à rajouter dans la macro pour me faire la bordure bas de chaque ligne "Taux d'affectation" à partir de la colonne C (Photo explicative en pièce-jointe).
Merci d'avance,
Cdlt,
Bonjour Bofala, bonjour le forum,
Quand je veux retoucher une photo j'utilise Photoshop et si je veux coder une macro je le fait avec Excel...
La photo ne montre ni le code, ni la fin du tableau. Donc inexploitable.
Le fichier, le fichier criait la foule en délire !...
Bonjour à tous,
Un essai au hasard du vent ...
Sub BordureDuBas()
Dim Dcol As Integer
Dim Dlig As Integer
Dim X As Integer
Dim Ws As Worksheet
Set Ws = Worksheets("Feuil1") ' << nom de la feuille à apdapter
Dcol = Ws.UsedRange.Columns.Count
Dlig = Ws.UsedRange.Rows.Count
For X = 1 To Dlig
If Left(Ws.Cells(X, "A"), 18) = "Taux d'affectation" Then
With Ws.Range(Cells(X, "C"), Cells(X, Dcol)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next X
End Subric
Excusez-moi, j'ai testé ton code mais ça ne fonctionne pas.
Je vous envoie le fichier qui contient la macro (GA_Macro_PIC...) et le fichier où exécuter.
(il faut regarder le code du bouton calculer compteurs totaux, Module "PlanningEquipe" et rajouter le traitement nécessaire pour la bordure bas)
Code d'accès vba : Paris2046!
MERCI BEAUCOUP !
Bonjour à tous,
Les fichiers fournis ne contiennent pas de cellules avec les mots "Taux d'affectation" .
ric
Exécute la macro (GA_MACRO_PIC..) et clique sur le bouton Calcul des compteurs totaux, c'est ce bouton qui crée ces lignes taux d'affectation. Il faudra juste rajouter un code qui fait la bordure bas. C'est clair maintenant ?
Bonjour à tous,
Un essai ...
remplace Private Sub Taux() par ceci ...
Private Sub Taux() 'Calcul de taux d'affectation
If Not Range("A10:A200").Find("Taux d'affectation", , , , xlByRows) Is Nothing Then rep = MsgBox("Mise en Forme déjà effectuée", vbCritical, "ATTENTION"): Exit Sub
'Range("B:B").Columns.Insert
Application.ScreenUpdating = False
DebCol = Range("A5:AB5").Find("01", , , xlPart, xlByColumns).column
CD = Chr(DebCol + 64)
TextLig = Cells(Range("A1500").End(xlUp).Row, 1)
ActLig = Cells(Range("A1500").End(xlUp).Row, 1).Row
NbEqp = 0: [Z1] = 0
Do While NbEqp = 0 And (ActLig + J) > 8
NbEqp = InStr(1, Cells(ActLig + J, 1), ":")
J = J - 1
If NbEqp > 0 Then [Z1] = [Z1] + 1: NbEqp = 0
Loop
'Equipe = LTrim(Right(Range("A" & ActLig + J), 2))
'[Z1] = CInt(Equipe):
Plage = "A1:A1500": [B1] = 1
For T = 1 To [Z1]
With ActiveSheet.Range(Plage)
Set LT = .Find(TextLig, , , , xlByRows)
If Not LT Is Nothing Then
Lin = LT.Row
End If
End With
Plage = "A" & Lin & ":A1500"
Cells(1, T + 2) = Lin
Next T
'***
PLig = Cells(1, T + 1)
Do Until Range("A" & PLig) Like "Planifiés"
PLig = PLig - 1
Loop
' "=R[Var]C[]/R[Var+2]C[]"
Col = 1: Var = "=IFERROR(R[" & (PLig - Lin - 1) & "]C[]/R[" & (PLig - Lin + 1) & "]C[],"""")"
DerJour = Left(Right(Range("A2"), 10), 2)
Col = Range("D5:AK5").Find(DerJour, , , xlPart, xlByColumns).column
For lig = 1 To Lin + ([Z1] - 1)
If Range("A" & lig) = TextLig Then
Rows(CStr(lig + 1) & ":" & lig + 1).Select
Selection.Insert Shift:=xlDown
Range(CD & [C1] - 3).Copy Range(Cells(lig + 1, DebCol), Cells(lig + 1, Col))
Application.CutCopyMode = False
Range("BZ" & lig + 1).FormulaR1C1 = Var
Range("BZ" & lig + 1).NumberFormat = "0.0%"
Range(CD & lig + 1).FormulaR1C1 = Var
Range(CD & lig + 1).NumberFormat = "0.0%"
Range(Cells(lig + 1, DebCol), Cells(lig + 1, Col)).FormulaR1C1 = Range(CD & lig + 1).FormulaR1C1: _
Range(Cells(lig + 1, 4), Cells(lig + 1, Col)).NumberFormat = "0.0%"
Range(Cells(lig, 1), Cells(lig, 2)).Copy Range("A" & lig + 1)
Application.CutCopyMode = False
Range("A" & lig + 1) = "Taux d'affectation"
If Left(Cells(lig + 1, "A"), 18) = "Taux d'affectation" Then
With Range(Cells(lig + 1, "C"), Cells(lig + 1, "AY")).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = RGB(89, 164, 219)
.TintAndShade = 0
.Weight = xlThin
End With
End If
End If
Next lig ' ici -------4
Range("A" & Lin + 2).Select: [A1] = PLig: '[D1] = Lin
TotalTab
End Subric
C'est parfait, c'est résolu. J'ai une autre demande stp : Une fois quand on clique sur le bouton, il nous donne la ligne taux d'affectation. Sur ces lignes taux d'affectation (calculé = ligne planifiés/ligne présents), j'ai des hashtags (#######), parce il y a 0 sur les lignes planifiés et sur présents. As-tu une solution pour supprimer ces hashtags ou de calculer le taux (avoir le taux 0,0 %) ??
MERCI D'AVANCE,
Ric,
C'est bon, c'est résolu. Je te remercie beaucoup pour ton aide très précieuse.
Si tu as un peu de temps STP, peux-tu jetter un coup d'oeil sur une autre demande ?
Lien d'accès direct : https://forum.excel-pratique.com/viewtopic.php?f=2&t=131504
MERCI MERCI MERCI MILLE FOIS !!
Bonsoir,
J'ai eu juste avant ton commentaire une aide de la part d'une autre personne sur le forum, même résultat que toi. Je vous remercie tous !!!
Si tu as un peu de temps, peux-tu aller au lien de l'autre demande que je t'avais envoyé en haut STP ?
MERCI ENCORE UNE FOIS,
Bonne soirée,
Bonjour Ric,
J'ai eu un souci STP sur les tableaux bleus (à part le tableau total où ça fonctionne déjà). Si tu fais la somme de n'importe quelles cellules dans tous les tableaux bleus (fichier exemple en PJ), elle te donne un résultat nul (0), alors ce n'est pas le cas (exemple photo: 0+12+12=24 pas 0)
Il faut modifier quelque chose dans le code vba de la macro pour avoir toujours les tableaux bleus sommables.
Code d'accès vba : Paris2046!
Merci encore,
Bonjour,
Le problème provient au moment où ces données sont écrites dans la feuille.
C'est à ce moment là où il faudrait intervenir.
L'on peut le faire aussi plus tard ...
Ceci convertit les données en données numériques.
Ce code n'opère que sur les cellules contenant des valeurs de la plage définie .
Sub ConversionDeDonnees()
Dim Cl As Range
For Each Cl In ActiveSheet.Range("D10:X69")
If IsNumeric(Cl) Then Cl = Cl * 1
Next Cl
End Subric
ric
ça l'air de fonctionner, nickel (MERCI BCP). Il me reste qu'un seul truc STP pour finaliser mon travail, c'est avoir un menu avec 2 boutons une fois qu'on exécute la macro : Premier bouton qui exécute la macro Feuille de chantier (Libellé : Imprimer la feuille de chantier) et le deuxième (Quitter) pour quitter le menu.
J'ai déjà créé le menu sur VBA, sur la feuille "Feuille", mais je n'arrive pas à l'affecter à la macro.
Fichiers en PJ :
- Fichier (GA_MACRO_PIC..) qui contient la macro Feuille_de_chantier. Il y en a 2 macros, il faut choisir feuille de chantier. Et un fichier exemple planning pour tester.
Code d'accès VBA : Paris2046!
Merci d'avance,
Bonjour,
Où est-il ce useform1 ???
ric
Bonjour,
C'est bon, je nettoyé mes verres.
ric
Bonjour,
VBA, Feuilles, Feuille..
Je l'ai créé, mais je ne suis pas sûr que son code est bon. Vérifie quand même stp. Si tu ne veux pas t’embêter, supprime la feuille et crée une autre pour faire le menu, c'est peut-être plus simple pour toi.
Bonjour,
Sur le userform "Feuille" ... le bouton dont le .caption est "Imprimer la feuille de chantier" porte le nom Feuilledechantier et la macro appelée se nomme Feuilledechantier d'où une certaine confusion ... même pour Excel.
J'ai renommé le bouton en Cmd_Feuilledechantier.
J'ai aussi nettoyé un peu les .select de la macro Feuilledechantier ... ils ne font que ralentir le traitement.
Un essai ...
ric
Bonjour,
J'ai testé mais ça ne donne pas le menu souhaité avec 2 boutons (un pour exécuter la macro et l'autre quitter pour quitter le menu). Tu l'as eu toi ?
PJ: Photo du menu souhaité
Cdlt,
Bonjour,
Ouupppssss!!!!! ... désolé ... trop heureux que le code fonctionne, j'ai zappé l'appel du userform.
Il y a une nouvelle macro PreparerImpression ... j'y ai déplacé le code.
Dans la macro Feuille_de_chantier ... il ne reste que l'appel du userform "Feuille".
Dans ce userform, le bouton appelle maintenant PreparerImpression.
Voir si ça convient ...
ric