Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
201
Réponses
2
Affichages
277
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…