problème dans VBA

A

Anthony93270

XLDnaute Nouveau
Bonjour tout le monde,

Pouvez-vous m'aiguiller sur le langage vba de mon fichier excel.

J'ai téléchargé et modifié un calendrier excel mais je voudrais que les dates ( lettre et chiffres) représentent qu'une cellule et soit afficher horizontalement.

je vous joins le fichier, si vous pouvez m'aider ca serait très sympa de votre part..

Merci d'avance,

Cordialement,..
 

Pièces jointes

  • CalendrierMaker.xls
    40.5 KB · Affichages: 76
  • CalendrierMaker.xls
    40.5 KB · Affichages: 79
  • CalendrierMaker.xls
    40.5 KB · Affichages: 76
Trier par date Trier par votes
bqtr

bqtr

XLDnaute Accro
Re : problème dans VBA

Bonsoir Anthony,

Essaye comme ceci : remplace la macro ComposerMois(Mois,Année) par celle-ci

Code: 
'*********************************************
'* Routine de création du calendrier mensuel *
'*********************************************
Sub ComposerMois(Mois, Année)
'* Déclaration des variables
Dim LargeurColonne As Byte, Jour As Integer
  
  '* Largeur de la 3e colonne du calendier
  '* MODIFIABLE
  LargeurColonne = 20
  '* Désactivation de l'affichage de la grille
  ActiveWindow.DisplayGridlines = False
  '* Insertion du nom du mois
  With ActiveSheet.Range("A1")
    .Value = Format(DateSerial(Année, Mois, 1), "mmmm yyyy")
    .Font.ColorIndex = Couleurs(3, 1)
    .Interior.ColorIndex = Couleurs(3, 0)
    '* Police, taille et gras
    '* MODIFIABLES
    .Font.Name = "Arial"
    .Font.Size = 14
    .Font.Bold = True
  End With
  '* Boucle d'insertion des jours
  For Jour = 1 To 31
    If Month(DateSerial(Année, Mois, Jour)) <> Mois Then Exit For
    '* Insertion du jour du mois
    'Range("A2").Offset(Jour, 1).Value = Jour
    '* Insertion du jour de la semaine
    Range("A2").Offset(Jour, 0).Value = Format(DateSerial(Année, Mois, Jour), "dddd dd mmmm yyyy")
    Range("A2").Offset(Jour, 0).HorizontalAlignment = xlRight
    Range([A2].Offset(Jour, 0), [A2].Offset(Jour, 1)).Select
    '* Les bordures
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = Couleurs(4, 0)
    End With
    '* Si c'est un jour de congé hebdomaire
    If Congés(Weekday(DateSerial(Année, Mois, Jour))) = 1 Then
    '* Application de la couleur réservée aux jours de congé
      Selection.Interior.ColorIndex = Couleurs(2, 0)
      Selection.Font.ColorIndex = Couleurs(2, 1)
      Selection.Interior.Pattern = xlSolid
    '* Sinon application de la couleur réservée aux jours de semaine
    Else
      Selection.Interior.ColorIndex = Couleurs(1, 0)
      Selection.Font.ColorIndex = Couleurs(1, 1)
      Selection.Interior.Pattern = xlSolid
    End If
    '* Est-ce un jour férié ?
    For Each cell In ThisWorkbook.Sheets("jours fériés").Range("A2:A50")
    '* Si c'est un jour férié ...
      If DateSerial(Année, Mois, Jour) = cell.Value Then
        '* ... introduction de la dénomination du jour
        Range("A2").Offset(Jour, 1).Value = cell.Offset(0, 1)
        Range("A2").Offset(Jour, 1).HorizontalAlignment = xlCenter
        '* et application de la couleur des jours de congé
        Selection.Interior.ColorIndex = Couleurs(2, 0)
        Selection.Interior.Pattern = xlSolid
        Selection.Font.ColorIndex = Couleurs(2, 1)
      End If
    Next
  Next
  '* Ajustement de la largeur des colonnes
  Columns("A:A").EntireColumn.AutoFit
'  Columns("A:A").EntireColumn.AutoFit
'  Columns("B:B").EntireColumn.AutoFit
  Columns("B:B").ColumnWidth = LargeurColonne

End Sub
A+
 
Vote positif 0 Vote négatif
A

Anthony93270

XLDnaute Nouveau
Re : problème dans VBA

Bonjour,
je vous remercie, ca avance..

Je voudrais surtout essayer d'afficher les dates de façon horizontale...
c'est à dire au lieu de la ligne 3 à 34 en général je voudrais que les dates s'affichent automatiaquement en colonnes de A à AE.

Si vous pouvez m'aider, je sèche.... :confused:

En vous remerciant d'avance.
 
Vote positif 0 Vote négatif
bqtr

bqtr

XLDnaute Accro
Re : problème dans VBA

Re,

Alors essaye comme ça :

Code: 
'*********************************************
'* Routine de création du calendrier mensuel *
'*********************************************
Sub ComposerMois(Mois, Année)
'* Déclaration des variables
Dim LargeurColonne As Byte, Jour As Integer
  
  '* Largeur de la 3e colonne du calendier
  '* MODIFIABLE
  LargeurColonne = 22
  '* Désactivation de l'affichage de la grille
  ActiveWindow.DisplayGridlines = False
  '* Insertion du nom du mois
  With ActiveSheet.Range("A1")
    .Value = Format(DateSerial(Année, Mois, 1), "mmmm yyyy")
    .Font.ColorIndex = Couleurs(3, 1)
    .Interior.ColorIndex = Couleurs(3, 0)
    '* Police, taille et gras
    '* MODIFIABLES
    .Font.Name = "Arial"
    .Font.Size = 14
    .Font.Bold = True
  End With
  '* Boucle d'insertion des jours
  For Jour = 1 To 31
    If Month(DateSerial(Année, Mois, Jour)) <> Mois Then Exit For
    '* Insertion du jour du mois
    'Range("A2").Offset(Jour, 1).Value = Jour
    '* Insertion du jour de la semaine
    Range("A2").Offset(1, Jour - 1).Value = Format(DateSerial(Année, Mois, Jour), "dddd dd mmmm yyyy")
    Range("A2").Offset(1, Jour - 1).HorizontalAlignment = xlCenter
    Range([A2].Offset(1, Jour - 1), [A2].Offset(2, Jour - 1)).Select
    '* Les bordures
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = Couleurs(4, 0)
    End With
    '* Si c'est un jour de congé hebdomaire
    If Congés(Weekday(DateSerial(Année, Mois, Jour))) = 1 Then
    '* Application de la couleur réservée aux jours de congé
      Selection.Interior.ColorIndex = Couleurs(2, 0)
      Selection.Font.ColorIndex = Couleurs(2, 1)
      Selection.Interior.Pattern = xlSolid
    '* Sinon application de la couleur réservée aux jours de semaine
    Else
      Selection.Interior.ColorIndex = Couleurs(1, 0)
      Selection.Font.ColorIndex = Couleurs(1, 1)
      Selection.Interior.Pattern = xlSolid
    End If
    '* Est-ce un jour férié ?
    For Each cell In ThisWorkbook.Sheets("jours fériés").Range("A2:A50")
    '* Si c'est un jour férié ...
      If DateSerial(Année, Mois, Jour) = cell.Value Then
        '* ... introduction de la dénomination du jour
        Range("A2").Offset(2, Jour - 1).Value = cell.Offset(0, 1)
        Range("A2").Offset(2, Jour - 1).HorizontalAlignment = xlCenter
        '* et application de la couleur des jours de congé
        Selection.Interior.ColorIndex = Couleurs(2, 0)
        Selection.Interior.Pattern = xlSolid
        Selection.Font.ColorIndex = Couleurs(2, 1)
      End If
    Next
  Next
  '* Ajustement de la largeur des colonnes
 ' Columns("A:AE").EntireColumn.AutoFit
'  Columns("A:A").EntireColumn.AutoFit
'  Columns("B:B").EntireColumn.AutoFit
  Columns("A:AE").ColumnWidth = LargeurColonne

End Sub

A+
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Programme VBA excel
Réponses
6
Affichages
253
mimilapino09
M
T
  • Résolu(e)
XL 2010 Formule - Recherche dans tableau
Réponses
2
Affichages
226
tchi456
T
F
  • Question
XL 2016 copier valeurs en vba
Réponses
10
Affichages
615
Fidmo
F
F
  • Question
XL 2016 doublons
2
Réponses
19
Affichages
651
finarobert
F
S
  • Résolu(e)
XL 2016 recopier VBA dans un autre fichier
2
Réponses
19
Affichages
1 K
shitoryu
S
F
  • Question
XL 2016 Onglets très masqués VBA à chaque réouverture de fichier
Réponses
4
Affichages
264
Fanny754
F
Z
  • Résolu(e)
XL 2013 Problème d’enregistrement de fichier avec calendrier
Réponses
8
Affichages
411
zegmanour
Z
A
  • Question
Autres VBA Chaîne de caractères de couleur à extraire dans cellule Excel
2
Réponses
21
Affichages
769
Armand11
A
C
  • Question
XL 2021 VBA pour comparer des données
Réponses
7
Affichages
376
Cristobal
C
@
  • Résolu(e)
Microsoft 365 planning
2
Réponses
17
Affichages
976
@lea
@

Membres actuellement en ligne

2 membres et 37 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 344
Messages
2 097 337
Membres
106 916
dernier inscrit
Soltani mohamed