j'ai un userform pour generer un calendrier, ou en premier lieu en fonction
du mois choisi je rempli une premiere ligne avec le nb de jours et ensuite
suivant le premier jour du mois( ex 2 pour lundi) je genere les nombre
jusqu'a 7 . pour ca c'est ok
ensuite je recherche la cellule vide a cote du 7 et je genere les nombre de
1 a 7 mais mon est que je souhaite repeter ceci jusqu au dernier jour du mois.
voici la macro:
Dim valeur As String, Ligne As Integer, c As Range
Dim strDate(1 To 2) As String
Dim nmois As String
Dim nannee As Integer
Dim yearin As String
Dim mydate As Variant
Dim jour As Variant
strDate1 = Date
strDate1 = Format(Date, "m")
strDate2 = Date
strDate2 = Format(Date, "mm")
jour = Format(Date, "ddd")
'-------------------'
'Change Month Format'
'-------------------'
If Mois.Value = "Janvier" Then
nmois = "1"
ElseIf Mois.Value = "Février" Then
nmois = "2"
ElseIf Mois.Value = "Mars" Then
nmois = "3"
ElseIf Mois.Value = "Avril" Then
nmois = "4"
ElseIf Mois.Value = "Mai" Then
nmois = "5"
ElseIf Mois.Value = "Juin" Then
nmois = "6"
ElseIf Mois.Value = "Juillet" Then
nmois = "7"
ElseIf Mois.Value = "Août" Then
nmois = "8"
ElseIf Mois.Value = "Septembre" Then
nmois = "9"
ElseIf Mois.Value = "Octobre" Then
nmois = "10"
ElseIf Mois.Value = "Novembre" Then
nmois = "11"
ElseIf Mois.Value = "Décembre" Then
nmois = "12"
End If
nannee = Year(Now)
'--------------------------------------'
'Check month select with month actually'
'--------------------------------------'
If nmois < strDate1 Then
MsgBox ("Creation Pointage Impossible")
Exit Sub
Else: GoTo Lemois
End If
'----------------------'
'Number of day by month'
'----------------------'
Lemois:
Select Case nmois
Case 1, 3, 5, 7, 8, 10, 12
nbjours = 31
Case 4, 6, 9, 11
nbjours = 30
'---------------------------'
'Special case about February'
'---------------------------'
Case Else
If Day(DateSerial(nannee, 2, 28) + 1) = 29 Then
nbjours = 29
Else
nbjours = 28
End If
End Select
'----------------------------------'
'search first day of month selected'
'----------------------------------'
yearin = Year(Now)
mydate = DateSerial(yearin, nmois, 1)
joursem = Weekday(mydate)
jour = joursem
jour = Format(joursem, "ddd")
'MsgBox "Pointage Demandé en Date du " & jour & " " & mydate
'-----------------------------------------------------'
'Search if Workbooks exist with same Month name select'
'-----------------------------------------------------'
Existemois:
If Dir("\\Dg6lb076\partagé\FM_" & yearin & "\Pointage_" & strDate2 & "_"
& Mois.Value & ".xls") = "" Then
GoTo Create
Else: MsgBox "Pointage Demandé Déjà Existant", vbExclamation
Exit Sub
End If
'-------------------'
'Create Excel Sheets'
'-------------------'
Create:
Application.Workbooks.Open
("\\Dg6lb076\partagé\FM_2005\Create_Pointage_First_Page.xls")
For i = 1 To nbjours
Range("d7").Cells(1, i).Value = i
Next
For i = joursem To 7
Range("d6").Cells(1, i - (joursem - 1)).Value = i
Next
Range("d6").Cells(1, (8 - joursem) + 1).Select
valeur = Empty
For Each c In Selection
If c.Value = valeur Then
Ligne = c.Column
End If
Next c
For i = 1 To 7
Cells(6, Ligne).Cells(1, i).Value = i
Next
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Marc VANSTEELANT
Salut,
Mais pourquoi réinventer la roue ? Ne vaut-il pas mieux utiliser un calendrier déjà tout fait et qui fonctionne nickel ? Dans VBA, menu outils, contrôles supplémentaires puis Contrôle calendrier 8.0 et tu pourras l'inserer dans ton UserForm
Marc
NB: Par contre il faudra distribuer l'OCX (MSCAL.OCX . HLP .DP .CNT) pour que les utilisateurs puissent utiliser ton calendrier dans ton fichier.
"christophe" a écrit dans le message de news:
bonjour,
Voila mon pb,
j'ai un userform pour generer un calendrier, ou en premier lieu en fonction du mois choisi je rempli une premiere ligne avec le nb de jours et ensuite suivant le premier jour du mois( ex 2 pour lundi) je genere les nombre jusqu'a 7 . pour ca c'est ok ensuite je recherche la cellule vide a cote du 7 et je genere les nombre de 1 a 7 mais mon est que je souhaite repeter ceci jusqu au dernier jour du mois. voici la macro: Dim valeur As String, Ligne As Integer, c As Range Dim strDate(1 To 2) As String Dim nmois As String Dim nannee As Integer Dim yearin As String Dim mydate As Variant Dim jour As Variant strDate1 = Date strDate1 = Format(Date, "m") strDate2 = Date strDate2 = Format(Date, "mm") jour = Format(Date, "ddd") '-------------------' 'Change Month Format' '-------------------' If Mois.Value = "Janvier" Then nmois = "1" ElseIf Mois.Value = "Février" Then nmois = "2" ElseIf Mois.Value = "Mars" Then nmois = "3" ElseIf Mois.Value = "Avril" Then nmois = "4" ElseIf Mois.Value = "Mai" Then nmois = "5" ElseIf Mois.Value = "Juin" Then nmois = "6" ElseIf Mois.Value = "Juillet" Then nmois = "7" ElseIf Mois.Value = "Août" Then nmois = "8" ElseIf Mois.Value = "Septembre" Then nmois = "9" ElseIf Mois.Value = "Octobre" Then nmois = "10" ElseIf Mois.Value = "Novembre" Then nmois = "11" ElseIf Mois.Value = "Décembre" Then nmois = "12" End If nannee = Year(Now) '--------------------------------------' 'Check month select with month actually' '--------------------------------------' If nmois < strDate1 Then MsgBox ("Creation Pointage Impossible") Exit Sub Else: GoTo Lemois End If
'----------------------' 'Number of day by month' '----------------------' Lemois: Select Case nmois Case 1, 3, 5, 7, 8, 10, 12 nbjours = 31 Case 4, 6, 9, 11 nbjours = 30 '---------------------------' 'Special case about February' '---------------------------' Case Else If Day(DateSerial(nannee, 2, 28) + 1) = 29 Then nbjours = 29 Else nbjours = 28 End If End Select '----------------------------------' 'search first day of month selected' '----------------------------------' yearin = Year(Now) mydate = DateSerial(yearin, nmois, 1) joursem = Weekday(mydate) jour = joursem jour = Format(joursem, "ddd") 'MsgBox "Pointage Demandé en Date du " & jour & " " & mydate '-----------------------------------------------------' 'Search if Workbooks exist with same Month name select' '-----------------------------------------------------' Existemois: If Dir("Dg6lb076partagéFM_" & yearin & "Pointage_" & strDate2 & "_" & Mois.Value & ".xls") = "" Then GoTo Create Else: MsgBox "Pointage Demandé Déjà Existant", vbExclamation Exit Sub End If '-------------------' 'Create Excel Sheets' '-------------------' Create: Application.Workbooks.Open ("Dg6lb076partagéFM_2005Create_Pointage_First_Page.xls") For i = 1 To nbjours Range("d7").Cells(1, i).Value = i Next For i = joursem To 7 Range("d6").Cells(1, i - (joursem - 1)).Value = i Next Range("d6").Cells(1, (8 - joursem) + 1).Select valeur = Empty For Each c In Selection If c.Value = valeur Then Ligne = c.Column End If Next c For i = 1 To 7 Cells(6, Ligne).Cells(1, i).Value = i Next
End Sub
Salut,
Mais pourquoi réinventer la roue ? Ne vaut-il pas mieux utiliser un
calendrier déjà tout fait et qui fonctionne nickel ?
Dans VBA, menu outils, contrôles supplémentaires puis Contrôle calendrier
8.0 et tu pourras l'inserer dans ton UserForm
Marc
NB: Par contre il faudra distribuer l'OCX (MSCAL.OCX . HLP .DP .CNT) pour
que les utilisateurs puissent utiliser ton calendrier dans ton fichier.
"christophe" <cgrosjean@europarl.eu.int> a écrit dans le message de news:
7616DAEB-DA07-4B03-B733-FA042CDB7C47@microsoft.com...
bonjour,
Voila mon pb,
j'ai un userform pour generer un calendrier, ou en premier lieu en
fonction
du mois choisi je rempli une premiere ligne avec le nb de jours et ensuite
suivant le premier jour du mois( ex 2 pour lundi) je genere les nombre
jusqu'a 7 . pour ca c'est ok
ensuite je recherche la cellule vide a cote du 7 et je genere les nombre
de
1 a 7 mais mon est que je souhaite repeter ceci jusqu au dernier jour du
mois.
voici la macro:
Dim valeur As String, Ligne As Integer, c As Range
Dim strDate(1 To 2) As String
Dim nmois As String
Dim nannee As Integer
Dim yearin As String
Dim mydate As Variant
Dim jour As Variant
strDate1 = Date
strDate1 = Format(Date, "m")
strDate2 = Date
strDate2 = Format(Date, "mm")
jour = Format(Date, "ddd")
'-------------------'
'Change Month Format'
'-------------------'
If Mois.Value = "Janvier" Then
nmois = "1"
ElseIf Mois.Value = "Février" Then
nmois = "2"
ElseIf Mois.Value = "Mars" Then
nmois = "3"
ElseIf Mois.Value = "Avril" Then
nmois = "4"
ElseIf Mois.Value = "Mai" Then
nmois = "5"
ElseIf Mois.Value = "Juin" Then
nmois = "6"
ElseIf Mois.Value = "Juillet" Then
nmois = "7"
ElseIf Mois.Value = "Août" Then
nmois = "8"
ElseIf Mois.Value = "Septembre" Then
nmois = "9"
ElseIf Mois.Value = "Octobre" Then
nmois = "10"
ElseIf Mois.Value = "Novembre" Then
nmois = "11"
ElseIf Mois.Value = "Décembre" Then
nmois = "12"
End If
nannee = Year(Now)
'--------------------------------------'
'Check month select with month actually'
'--------------------------------------'
If nmois < strDate1 Then
MsgBox ("Creation Pointage Impossible")
Exit Sub
Else: GoTo Lemois
End If
'----------------------'
'Number of day by month'
'----------------------'
Lemois:
Select Case nmois
Case 1, 3, 5, 7, 8, 10, 12
nbjours = 31
Case 4, 6, 9, 11
nbjours = 30
'---------------------------'
'Special case about February'
'---------------------------'
Case Else
If Day(DateSerial(nannee, 2, 28) + 1) = 29 Then
nbjours = 29
Else
nbjours = 28
End If
End Select
'----------------------------------'
'search first day of month selected'
'----------------------------------'
yearin = Year(Now)
mydate = DateSerial(yearin, nmois, 1)
joursem = Weekday(mydate)
jour = joursem
jour = Format(joursem, "ddd")
'MsgBox "Pointage Demandé en Date du " & jour & " " & mydate
'-----------------------------------------------------'
'Search if Workbooks exist with same Month name select'
'-----------------------------------------------------'
Existemois:
If Dir("\Dg6lb076partagéFM_" & yearin & "Pointage_" & strDate2 &
"_"
& Mois.Value & ".xls") = "" Then
GoTo Create
Else: MsgBox "Pointage Demandé Déjà Existant", vbExclamation
Exit Sub
End If
'-------------------'
'Create Excel Sheets'
'-------------------'
Create:
Application.Workbooks.Open
("\Dg6lb076partagéFM_2005Create_Pointage_First_Page.xls")
For i = 1 To nbjours
Range("d7").Cells(1, i).Value = i
Next
For i = joursem To 7
Range("d6").Cells(1, i - (joursem - 1)).Value = i
Next
Range("d6").Cells(1, (8 - joursem) + 1).Select
valeur = Empty
For Each c In Selection
If c.Value = valeur Then
Ligne = c.Column
End If
Next c
For i = 1 To 7
Cells(6, Ligne).Cells(1, i).Value = i
Next
Mais pourquoi réinventer la roue ? Ne vaut-il pas mieux utiliser un calendrier déjà tout fait et qui fonctionne nickel ? Dans VBA, menu outils, contrôles supplémentaires puis Contrôle calendrier 8.0 et tu pourras l'inserer dans ton UserForm
Marc
NB: Par contre il faudra distribuer l'OCX (MSCAL.OCX . HLP .DP .CNT) pour que les utilisateurs puissent utiliser ton calendrier dans ton fichier.
"christophe" a écrit dans le message de news:
bonjour,
Voila mon pb,
j'ai un userform pour generer un calendrier, ou en premier lieu en fonction du mois choisi je rempli une premiere ligne avec le nb de jours et ensuite suivant le premier jour du mois( ex 2 pour lundi) je genere les nombre jusqu'a 7 . pour ca c'est ok ensuite je recherche la cellule vide a cote du 7 et je genere les nombre de 1 a 7 mais mon est que je souhaite repeter ceci jusqu au dernier jour du mois. voici la macro: Dim valeur As String, Ligne As Integer, c As Range Dim strDate(1 To 2) As String Dim nmois As String Dim nannee As Integer Dim yearin As String Dim mydate As Variant Dim jour As Variant strDate1 = Date strDate1 = Format(Date, "m") strDate2 = Date strDate2 = Format(Date, "mm") jour = Format(Date, "ddd") '-------------------' 'Change Month Format' '-------------------' If Mois.Value = "Janvier" Then nmois = "1" ElseIf Mois.Value = "Février" Then nmois = "2" ElseIf Mois.Value = "Mars" Then nmois = "3" ElseIf Mois.Value = "Avril" Then nmois = "4" ElseIf Mois.Value = "Mai" Then nmois = "5" ElseIf Mois.Value = "Juin" Then nmois = "6" ElseIf Mois.Value = "Juillet" Then nmois = "7" ElseIf Mois.Value = "Août" Then nmois = "8" ElseIf Mois.Value = "Septembre" Then nmois = "9" ElseIf Mois.Value = "Octobre" Then nmois = "10" ElseIf Mois.Value = "Novembre" Then nmois = "11" ElseIf Mois.Value = "Décembre" Then nmois = "12" End If nannee = Year(Now) '--------------------------------------' 'Check month select with month actually' '--------------------------------------' If nmois < strDate1 Then MsgBox ("Creation Pointage Impossible") Exit Sub Else: GoTo Lemois End If
'----------------------' 'Number of day by month' '----------------------' Lemois: Select Case nmois Case 1, 3, 5, 7, 8, 10, 12 nbjours = 31 Case 4, 6, 9, 11 nbjours = 30 '---------------------------' 'Special case about February' '---------------------------' Case Else If Day(DateSerial(nannee, 2, 28) + 1) = 29 Then nbjours = 29 Else nbjours = 28 End If End Select '----------------------------------' 'search first day of month selected' '----------------------------------' yearin = Year(Now) mydate = DateSerial(yearin, nmois, 1) joursem = Weekday(mydate) jour = joursem jour = Format(joursem, "ddd") 'MsgBox "Pointage Demandé en Date du " & jour & " " & mydate '-----------------------------------------------------' 'Search if Workbooks exist with same Month name select' '-----------------------------------------------------' Existemois: If Dir("Dg6lb076partagéFM_" & yearin & "Pointage_" & strDate2 & "_" & Mois.Value & ".xls") = "" Then GoTo Create Else: MsgBox "Pointage Demandé Déjà Existant", vbExclamation Exit Sub End If '-------------------' 'Create Excel Sheets' '-------------------' Create: Application.Workbooks.Open ("Dg6lb076partagéFM_2005Create_Pointage_First_Page.xls") For i = 1 To nbjours Range("d7").Cells(1, i).Value = i Next For i = joursem To 7 Range("d6").Cells(1, i - (joursem - 1)).Value = i Next Range("d6").Cells(1, (8 - joursem) + 1).Select valeur = Empty For Each c In Selection If c.Value = valeur Then Ligne = c.Column End If Next c For i = 1 To 7 Cells(6, Ligne).Cells(1, i).Value = i Next