XL 2013 (RESOLU) Simplifier un code fonctionnel

chaelie2015

XLDnaute Accro
Bonjour Forum
Le code ci-dessous réalise les actions suivantes :
  1. Définit la feuille de travail "CRT".
  2. Récupère le mois et l'année sélectionnés.
  3. Annule la fusion et vide le contenu des cellules dans la colonne A (A17:B47).
  4. Si le mois est valide, il détermine le dernier jour du mois et remplit les cellules correspondantes.
  5. Masque ou affiche les lignes vides dans la colonne A (A17:B47).
  6. Fusionne à nouveau les cellules dans la colonne A (A17:B47)
J'aimerais que l'action N° 3 ne soit pas visible lors de son exécution.
Merci d'avance.

VB:
Sub RemplirDates()
    Dim ws As Worksheet         ' Déclaration de la feuille de travail
    Dim mois As Integer        ' Variable pour le mois sélectionné (en chiffre)
    Dim annee As Integer       ' Variable pour l'année sélectionnée
    Dim dernierJour As Integer ' Variable pour le dernier jour du mois
    Dim i As Integer           ' Variable pour la boucle
    
    ' Définir la feuille de travail "CRT"
    Set ws = ThisWorkbook.Sheets("CRT")
    
    ' Récupérer le mois sélectionné (en chiffre) dans la cellule AM6
    ' et l'année sélectionnée dans la cellule AL5
    mois = ws.Range("AM6").Value
    annee = ws.Range("AL5").Value
    
    ' Annuler la fusion des cellules et vider leur contenu dans la colonne A (A17:B47)
    For i = 17 To 47
        ws.Range("A" & i & ":B" & i).UnMerge
        ws.Range("A" & i & ":B" & i).ClearContents
    Next i
    
    ' Si le mois est valide (entre 1 et 12)
    If mois >= 1 And mois <= 12 Then
        ' Déterminer le dernier jour du mois en fonction de l'année et du mois
        dernierJour = Day(DateSerial(annee, mois + 1, 0))
        
        ' Remplir les cellules de la colonne DATE (A17:A47) avec les jours du mois
        For i = 17 To dernierJour + 16 ' +16 pour décaler à partir de 1
            ws.Range("A" & i).Value = i - 16
        Next i
    End If
    
    ' Masquer ou afficher les lignes vides dans la colonne A (A17:B47)
    For i = 17 To 47
        If ws.Range("A" & i).Value = "" Then
            ws.Rows(i).Hidden = True
        Else
            ws.Rows(i).Hidden = False
        End If
    Next i
    
    ' Fusionner à nouveau les cellules dans la colonne A (A17:B47)
    For i = 17 To 47
        ws.Range("A" & i & ":B" & i).Merge
    Next i
End Sub
 

Pièces jointes

  • Charlie Code simplifier.xlsm
    18.6 KB · Affichages: 2

Discussions similaires

Réponses
5
Affichages
431

Statistiques des forums

Discussions
314 708
Messages
2 112 090
Membres
111 416
dernier inscrit
philipperoy83