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.58

Cdlt

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".

21test-gmao-1.zip (290.93 Ko)

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 Sub

Cdlt

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 Sub

Cdlt

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 Sub

Supprimez 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 Sub

Comme 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 :

capture

sur la ligne suivante :

capture1

É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 Worksheet

Autant pour moi tout fonctionne !!

Merci pour tout !

Cordialement

Rechercher des sujets similaires à "ajuster automatiquement largeur conditions"