Ajuster automatiquement la largeur de cellules sous conditions
Bonjour,
Je réalise une GMAO pour mon projet professionnel de Licence Pro, je réalise donc un planning de maintenance qui est déroulant vers le passé et le futur.
Dans ce tableau, je voudrais que les colonnes des week-ends et jours fériés se réduisent (en restant légèrement visible, par exemple 0,58 points). Ayant parcouru de nombreuses vidéos et sites internet je n'arrive pas à trouver une aide pour réaliser ma macro. Je suis débutant sur VBA.
J'espère avoir été clair et je reste à votre disposition pour plus d'informations si besoin (je pense qu'il y en aura besoin).
Merci d'avance pour tout ce que vous allez m'apporter.
Allan
Bonjour,
Utilisez l'enregistreur de macro, une fois que vous avez votre code, vous pouvez le modifier à votre guise
Exemple pour forcer la colonne C à la largeur 0.58 (attention le point remplace la virgule en VBA)
Columns(3).ColumnWidth = 0.58Cdlt
Bonjour,
Mon tableau étant déroulant et ne comprenant qu'une trentaine de jours, les week-ends et jours fériés ne ce retrouve pas toujours sur la même colonne. C'est pour cela que je voudrais mettre des conditions à la formule que vous me proposé.
Cordialement
Mais si vous ne montrez pas sur quoi vous travaillez avec des explications correctes sur le but à atteindre, je ne peux pas devinez ce qu'il faut faire,
Voici mon fichier. Le tableau concerné se trouve sur la feuille "Planning de maintenance".
Ceci
Sub Reduction_Colonnes()
Dim DerCol As Long
Dim f1 As Worksheet
Application.ScreenUpdating = False
Set f1 = Sheets("Planning de Maintenance")
DerCol = f1.Range("ZZ6").End(xlToLeft).Column
For i = 8 To DerCol
If Application.WorksheetFunction.Weekday(Cells(6, i)) > 5 Then
Columns(i).ColumnWidth = 0.58
Else
Columns(i).ColumnWidth = 2.71
End If
Next i
End SubCdlt
Bonjour,
La macro que vous proposez modifie bien la largeur mais je penses que les conditions ne sont pas les bonnes, lorsque nous nous déplaçons vers le futur les colonnes modifiées reste statique tandis que les week-ends et jours fériés changent de position sur le calendrier.
Je pense qu'on pourrait utiliser les dates des jours fériés calculés automatiquement sur la feuille "Données", et pour les week-ends je ne sais pas s'il faut questionner si les cellules (H8:AL8) sont égalent à "S" ou "D".
Cordialement
Bonjour,
La macro ne fonctionne pas pour deux raisons, d'une part, j'ai oublié un argument dans la détection du jour , et d'autre part, il faut que la macro soit appelée lors de la modification de date, cela, je pensais que vous l'auriez fait de vous même.
Voici le code au complet à mettre dans le module de la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AT$11" Then Reduction_Colonnes
End Sub
Sub Reduction_Colonnes()
Dim DerCol As Long
Dim f1 As Worksheet
Application.ScreenUpdating = False
Set f1 = Sheets("Planning de Maintenance")
DerCol = f1.Range("ZZ6").End(xlToLeft).Column
For i = 8 To DerCol
If Application.WorksheetFunction.Weekday(Cells(6, i), 2) > 5 Then
Columns(i).ColumnWidth = 0.58
Else
Columns(i).ColumnWidth = 2.71
End If
Next i
End SubCdlt
Super ça fonctionne !! Peut-on élargir cette macro sur les jours fériés ?
Bonjour,
Peut-on élargir cette macro sur les jours fériés ?
Oui, modification des macros dans le module "Thisworkbook"
Sub Date_Hier_boucle()
Dim Date_Hier As Date
For i = 1 To 3 'boucle qui permet d'ajouter 3 jrs a la date de la cel il
Date_Hier = Cells(6, 8) - i
Cells(11, 46) = Date_Hier 'mettre dans la boucle pour visualiser le chgt de jour
Next i
Reduction_Colonnes
End Sub
Sub Date_du_jour()
Cells(11, 46) = Date
Reduction_Colonnes
End Sub
Sub Date_demain_boucle()
Dim Date_Demain As Date
For i = 1 To 3 'boucle qui permet d'ajouter 3 jrs a la date de la cel I1
Date_Demain = Cells(6, 8) + i
Cells(11, 46) = Date_Demain 'mettre dans la boucle pour visualiser le chgt de jour
Next i
Reduction_Colonnes
End SubSupprimez la macro "Reduction_Colonnes" dans le module de la feuille "Planning de maintenance".
et copiez ceci dans un module standard:
Dim f1 As Worksheet, f2 As Worksheet
Sub Reduction_Colonnes()
Dim DerCol As Long
Application.ScreenUpdating = False
Set f1 = Sheets("Planning de Maintenance")
Set f2 = Sheets("Données")
f2.Range("Z5:Z17").Value = f2.Range("Z5:Z17").Value
f2.Range("Z5:Z17").NumberFormat = "0"
DerCol = f1.Range("ZZ6").End(xlToLeft).Column
For i = 8 To DerCol
On Error Resume Next
Date_Jour = f1.Cells(6, i) * 1
Set Plage_Feries = f2.Range("Z5:Z17")
Columns(i).ColumnWidth = 2.71
If Application.WorksheetFunction.Weekday(Cells(6, i), 2) > 5 Then If Err.Number = 0 Then Columns(i).ColumnWidth = 0.58
If Application.Match(Date_Jour, Plage_Feries, 0) > 0 Then
If Err.Number = 0 Then Columns(i).ColumnWidth = 0.58
End If
On Error GoTo 0
Next i
Formules_jours_feries
Set f1 = Nothing
Set f2 = Nothing
End Sub
Sub Formules_jours_feries()
Application.Calculation = xlCalculationManual
f2.Range("Z5").FormulaR1C1 = "= DATE(R2C29,1,1)"
f2.Range("Z6").FormulaR1C1 = "= FLOOR(DAY(MINUTE(R2C29/38)/2+56)&""/5/""&R2C29,7)-34"
f2.Range("Z7").FormulaR1C1 = "=R[-1]C+1"
f2.Range("Z8").FormulaR1C1 = "= DATE(R2C29,5,1)"
f2.Range("Z9").FormulaR1C1 = "= DATE(R2C29,5,8)"
f2.Range("Z10").FormulaR1C1 = "=R[-4]C+39"
f2.Range("Z11").FormulaR1C1 = "=R[-5]C+49"
f2.Range("Z12").FormulaR1C1 = "=R[-6]C+50"
f2.Range("Z13").FormulaR1C1 = "= DATE(R2C29,7,14)"
f2.Range("Z14").FormulaR1C1 = "= DATE(R2C29,8,15)"
f2.Range("Z15").FormulaR1C1 = "= DATE(R2C29,11,1)"
f2.Range("Z16").FormulaR1C1 = "= DATE(R2C29,11,11)"
f2.Range("Z17").FormulaR1C1 = "= DATE(R2C29,12,25)"
f2.Range("Z5:Z17").NumberFormat = "m/d/yyyy"
Application.Calculation = xlCalculationAutomatic
End SubComme vous travaillez avec une version excel plus récente que la mienne, je ne peux pas enregistrer le fichier tel qu'il est puisqu'il contient des fonctions qui n'existent dans ma version, ce qui fait planter excel à chaque tentative d'enregistrement.
Je vous mets ici le fichier allégé de toutes les feuilles et formules inadaptées. pour en vérifier le bon fonctionnement.
Cdlt
Bonjour,
J'ai télécharger votre document simplifier, tout fonctionne très bien. Je copie/colle les macros mais lorsque je les exécute, une erreur survient :
sur la ligne suivante :
Étant débutant je ne comprends pas toutes les erreurs, et il m'est difficile d'avancer. Je vous remercie pour toutes les modifications que vous m'apportez.
Cordialement
Bonjour,
N'avez-vous pas oubliez la première ligne tout en haut du module standard?
Dim f1 As Worksheet, f2 As WorksheetAutant pour moi tout fonctionne !!
Merci pour tout !
Cordialement