begin process at 2012 02 09 01:21:27
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > CALENDRIER SOUS ACCES 2000

CALENDRIER SOUS ACCES 2000


 Information sur la source

Note :
8,75 / 10 - par 4 personnes
8,75 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :VBA Niveau :Débutant Date de création :15/07/2002 Date de mise à jour :15/07/2002 16:20:58 Vu / téléchargé :16 247 / 2 402

Auteur : Jerrymcfly

Ecrire un message privé
Commentaire sur cette source (9)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
Vous en avez marre de taper des dates ?
Avec un formulaire et un module, vous pourrez ajouter un calendrier à vos applications.

Il gère les jours fériés, un affichage different pour les jours ouvrés.
Pour les jours ouvrés j'ai choisi de passer par un fichier ".ini" car je me sers du calendrier comme complément installé. ce qui permet à l'utilsateur final de modifier les jours ouvrés sans avoir acces aux sources.  

Inserez :

Zone_a_dater = calendrier(zone_a_dater)

Le parametre permet d'afficher la date qu'il y a dans la zone avant d'afficher le calendrier, si vous ne passez rien, le calendrier par de la date systeme de votre ordi.

Manipulation:
- echap pour annuler
- double clic ou touche entrée pour valider
- déplacement avec les fleches directionnelles possible
- pageup/down fait descendre/monter dans les mois

bon ok, c pas terrible, mais depuis que je pompe des trucs ici, je me devais de mettre qqchose. Destiné aux débutans, ou aux fleimards comme moi.
    

Source

  • '
  • ' CALENDRIER
  • ' JerryMcFly - 08/04/2000
  • '
  • Option Compare Database
  • '*
  • '* Définition des parametres et variables
  • '*
  • '### Parametres : Jours Ouvrés
  • Public JO1 As Boolean
  • Public JO2 As Boolean
  • Public JO3 As Boolean
  • Public JO4 As Boolean
  • Public JO5 As Boolean
  • Public JO6 As Boolean
  • Public JO7 As Boolean
  • '### Constantes : Couleurs
  • Const Couleur_Jour_NO = 13209
  • Const Couleur_Jour_O = 0
  • '### Varaibles
  • Public Vdate As String
  • Public Vjour As Integer
  • Public Vsemaine As Integer
  • Public Vmois As Integer
  • Public Vannée As Long
  • Public Vprem_jour As Integer
  • Public Vnb_jours As Integer
  • '### Initialisation des parametres
  • Private Function init_param()
  • JO1 = GetIni("JOURS OUVRES", "Lundi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO2 = GetIni("JOURS OUVRES", "Mardi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO3 = GetIni("JOURS OUVRES", "Mercredi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO4 = GetIni("JOURS OUVRES", "Jeudi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO5 = GetIni("JOURS OUVRES", "Vendredi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO6 = GetIni("JOURS OUVRES", "Samedi", CurrentProject.Path & "\parametres\Calendrier.ini")
  • JO7 = GetIni("JOURS OUVRES", "Dimanche", CurrentProject.Path & "\parametres\Calendrier.ini")
  • End Function
  • '### 1ere Initialisation du calendrier a l'ouverture
  • Private Sub Form_Load()
  • init_param
  • calc_var
  • End Sub
  • '*
  • '* Capture des evenements Clavier
  • '*
  • Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  • Select Case KeyCode
  • 'annulation - validation
  • Case vbKeyEscape: Vdate = "": Me.Visible = False
  • Case vbKeyReturn: Me.Visible = False
  • 'deplacement dans les jours
  • Case vbKeyRight: Vdate = DateAdd("d", 1, Vdate): calc_var
  • Case vbKeyLeft: Vdate = DateAdd("d", -1, Vdate): calc_var
  • 'deplacement dans les semaines
  • Case vbKeyDown: Vdate = DateAdd("d", 7, Vdate): calc_var
  • Case vbKeyUp: Vdate = DateAdd("d", -7, Vdate): calc_var
  • 'deplacement dans les mois
  • Case vbKeyPageUp: Vdate = DateAdd("m", -1, Vdate): calc_var
  • Case vbKeyPageDown: Vdate = DateAdd("m", 1, Vdate): calc_var
  • End Select
  • KeyCode = 0
  • End Sub
  • '*
  • '* FONCTION PRINCIPALE : calcul des variables et affichage du calendrier
  • '*
  • Private Function calc_var()
  • Dim PT As Integer: Dim PTCase As String
  • If Vdate = "" Or IsNull(Vdate) Then Vdate = Date
  • Vjour = CInt(Day(Vdate))
  • Vmois = CInt(Month(Vdate))
  • Vannée = CLng(Year(Vdate))
  • Vprem_jour = CInt(Weekday("01/" & Vmois & "/" & Vannée, vbMonday))
  • Vnb_jours = CInt((DateAdd("m", 1, "01/" & Vmois & "/" & Vannée) _
  • - (CDate("01/" & Vmois & "/" & Vannée))))
  • 'Masquage de toutes les cases
  • For PT = 1 To 42
  • PTCase = "J" & Format(PT, "00")
  • Me(PTCase).BorderStyle = 0
  • Me(PTCase).Visible = False
  • Next
  • 'Affichage des jours
  • For PT = 1 To Vnb_jours
  • PTCase = "J" & Format(PT + Vprem_jour - 1, "00")
  • With Me(PTCase)
  • .ForeColor = Couleur_jour(PT & "/" & Vmois & "/" & Vannée)
  • If Ferié(PT & "/" & Vmois & "/" & Vannée) Then .ForeColor = Couleur_Jour_NO
  • .Caption = PT
  • .Visible = True
  • If PT = Vjour Then .BorderStyle = 1
  • End With
  • Next
  • ListMois = Vmois
  • SelAnnée = Vannée
  • End Function
  • '*
  • '* SS Fonction, renvoie la couleur du jour en Fonction de Jour ouvré OUI/NON
  • '*
  • Private Function Couleur_jour(Journée) As Long
  • Couleur_jour = Couleur_Jour_NO
  • Select Case Weekday(Journée, vbMonday)
  • Case 1: If JO1 Then Couleur_jour = Couleur_Jour_O
  • Case 2: If JO2 Then Couleur_jour = Couleur_Jour_O
  • Case 3: If JO3 Then Couleur_jour = Couleur_Jour_O
  • Case 4: If JO4 Then Couleur_jour = Couleur_Jour_O
  • Case 5: If JO5 Then Couleur_jour = Couleur_Jour_O
  • Case 6: If JO6 Then Couleur_jour = Couleur_Jour_O
  • Case 7: If JO7 Then Couleur_jour = Couleur_Jour_O
  • End Select
  • End Function
  • '*
  • '* SS Fonction, encadre le jour demandé
  • '*
  • Private Function Eff_Bords(JS As Integer)
  • 'Masquage de tous les contours
  • For i = 1 To 42
  • Icase = "J" & Format(i, "00")
  • Me(Icase).BorderStyle = 0
  • If i = JS Then Me(Icase).BorderStyle = 1
  • Next
  • Icase = "J" & Format(JS, "00")
  • Vdate = JS - Vprem_jour + 1 & "/" & Vmois & "/" & Vannée
  • Do While Not Me(Icase).Visible
  • JS = JS - 1
  • Vdate = JS - Vprem_jour + 1 & "/" & Vmois & "/" & Vannée
  • Loop
  • End Function
  • '*
  • '* Déplacements dans les Mois et années par les contrôles du formulaire
  • '*
  • Private Sub ListMois_AfterUpdate()
  • Vdate = DateAdd("m", ListMois - Vmois, Vdate): calc_var
  • End Sub
  • Private Sub SpinMois_SpinDown()
  • Vdate = DateAdd("yyyy", -1, Vdate): calc_var
  • End Sub
  • Private Sub SpinMois_SpinUp()
  • Vdate = DateAdd("yyyy", 1, Vdate): calc_var
  • End Sub
'
' CALENDRIER
' JerryMcFly -  08/04/2000                                                       
'

Option Compare Database


'*
'* Définition des parametres et variables
'*

'### Parametres : Jours Ouvrés
Public JO1 As Boolean
Public JO2 As Boolean
Public JO3 As Boolean
Public JO4 As Boolean
Public JO5 As Boolean
Public JO6 As Boolean
Public JO7 As Boolean

'### Constantes : Couleurs
Const Couleur_Jour_NO = 13209
Const Couleur_Jour_O = 0

'### Varaibles
Public Vdate As String
Public Vjour As Integer
Public Vsemaine As Integer
Public Vmois As Integer
Public Vannée As Long
Public Vprem_jour As Integer
Public Vnb_jours As Integer

'### Initialisation des parametres
Private Function init_param()
    JO1 = GetIni("JOURS OUVRES", "Lundi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO2 = GetIni("JOURS OUVRES", "Mardi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO3 = GetIni("JOURS OUVRES", "Mercredi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO4 = GetIni("JOURS OUVRES", "Jeudi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO5 = GetIni("JOURS OUVRES", "Vendredi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO6 = GetIni("JOURS OUVRES", "Samedi", CurrentProject.Path & "\parametres\Calendrier.ini")
    JO7 = GetIni("JOURS OUVRES", "Dimanche", CurrentProject.Path & "\parametres\Calendrier.ini")
End Function

'### 1ere Initialisation du calendrier a l'ouverture
Private Sub Form_Load()
init_param
calc_var
End Sub

'*
'* Capture des evenements Clavier
'*
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        'annulation - validation
        Case vbKeyEscape: Vdate = "": Me.Visible = False
        Case vbKeyReturn: Me.Visible = False
        'deplacement dans les jours
        Case vbKeyRight: Vdate = DateAdd("d", 1, Vdate): calc_var
        Case vbKeyLeft: Vdate = DateAdd("d", -1, Vdate): calc_var
        'deplacement dans les semaines
        Case vbKeyDown: Vdate = DateAdd("d", 7, Vdate): calc_var
        Case vbKeyUp: Vdate = DateAdd("d", -7, Vdate): calc_var
        'deplacement dans les mois
        Case vbKeyPageUp: Vdate = DateAdd("m", -1, Vdate): calc_var
        Case vbKeyPageDown: Vdate = DateAdd("m", 1, Vdate): calc_var
    End Select
    KeyCode = 0
End Sub



'*
'*  FONCTION PRINCIPALE : calcul des variables et affichage du calendrier
'*
Private Function calc_var()
    Dim PT As Integer: Dim PTCase As String
    
    If Vdate = "" Or IsNull(Vdate) Then Vdate = Date
    Vjour = CInt(Day(Vdate))
    Vmois = CInt(Month(Vdate))
    Vannée = CLng(Year(Vdate))
    Vprem_jour = CInt(Weekday("01/" & Vmois & "/" & Vannée, vbMonday))
    Vnb_jours = CInt((DateAdd("m", 1, "01/" & Vmois & "/" & Vannée) _
                - (CDate("01/" & Vmois & "/" & Vannée))))
    
    'Masquage de toutes les cases
    For PT = 1 To 42
        PTCase = "J" & Format(PT, "00")
        Me(PTCase).BorderStyle = 0
        Me(PTCase).Visible = False
    Next
    
    'Affichage des jours
    For PT = 1 To Vnb_jours
        PTCase = "J" & Format(PT + Vprem_jour - 1, "00")
        With Me(PTCase)
            .ForeColor = Couleur_jour(PT & "/" & Vmois & "/" & Vannée)
            If Ferié(PT & "/" & Vmois & "/" & Vannée) Then .ForeColor = Couleur_Jour_NO
            .Caption = PT
            .Visible = True
            If PT = Vjour Then .BorderStyle = 1
        End With
    Next
    ListMois = Vmois
    SelAnnée = Vannée
End Function

'*
'* SS Fonction, renvoie la couleur du jour en Fonction de Jour ouvré OUI/NON
'*
Private Function Couleur_jour(Journée) As Long
    Couleur_jour = Couleur_Jour_NO
    Select Case Weekday(Journée, vbMonday)
        Case 1: If JO1 Then Couleur_jour = Couleur_Jour_O
        Case 2: If JO2 Then Couleur_jour = Couleur_Jour_O
        Case 3: If JO3 Then Couleur_jour = Couleur_Jour_O
        Case 4: If JO4 Then Couleur_jour = Couleur_Jour_O
        Case 5: If JO5 Then Couleur_jour = Couleur_Jour_O
        Case 6: If JO6 Then Couleur_jour = Couleur_Jour_O
        Case 7: If JO7 Then Couleur_jour = Couleur_Jour_O
    End Select
End Function

'*
'* SS Fonction, encadre le jour demandé                                                         
'*
Private Function Eff_Bords(JS As Integer)
    'Masquage de tous les contours
    For i = 1 To 42
        Icase = "J" & Format(i, "00")
        Me(Icase).BorderStyle = 0
        If i = JS Then Me(Icase).BorderStyle = 1
    Next
    Icase = "J" & Format(JS, "00")
    Vdate = JS - Vprem_jour + 1 & "/" & Vmois & "/" & Vannée
    Do While Not Me(Icase).Visible
        JS = JS - 1
        Vdate = JS - Vprem_jour + 1 & "/" & Vmois & "/" & Vannée
    Loop
End Function

'*
'* Déplacements dans les Mois et années par les contrôles du formulaire 
'*
Private Sub ListMois_AfterUpdate()
Vdate = DateAdd("m", ListMois - Vmois, Vdate): calc_var
End Sub
Private Sub SpinMois_SpinDown()
Vdate = DateAdd("yyyy", -1, Vdate): calc_var
End Sub
Private Sub SpinMois_SpinUp()
Vdate = DateAdd("yyyy", 1, Vdate): calc_var
End Sub
    


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources de la même categorie

Source avec Zip GESTION PERSONNEL par oudlarbi
Source avec Zip Source avec une capture CALENDRIER EN VBA POUR EXCEL 2010 par nounou94
Source avec Zip Source avec une capture MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai
Source avec Zip Source avec une capture COLLECTION ID par Le Pivert
Source avec Zip Source avec une capture VBA MASQUE DE SAISIE NUMÉRIQUE par acive

Commentaires et avis

Commentaire de PtitJeoJeo le 16/07/2002 15:12:48

heu ben il existe deja un control qui fait ca !!!! dsl sinon c pa mal kom truc !
PtitJeoJeo

Commentaire de DracoDeath le 15/07/2004 11:01:08

Ton code est géniale mais une erreur  s'affiche chez moi.
Incompatibilité de type, et le débogguage se met sur
la fonction Init-paramet au niveau de JO1.
Alors si tu pouvais m'aider ça serait cool.

Commentaire de sebar le 13/11/2004 18:24:50

Ca fonctionne bien je cherchais ce code. Pour l'utilisé, il faut mettre le dossier paramètre et son programme acces dans un même répertoire, pour éviter le bog sue la fonction init parmet

Commentaire de dsomped le 18/04/2005 16:11:14

Malheureusement format du fichier mdb non reconnu par Access 97

Commentaire de CRUSOE13 le 21/07/2005 23:28:23

Très intéressant, nouvelle approche par rapport à celle qui consiste à utiliser un contrôle ActiveX, souplesse dans la gestion des jours fériés, beau design (sobre).
Pas encore d'avis sur la prog. en elle-même, car pas encore intégré.

Commentaire de Z0zo le 26/02/2006 19:45:56

He bien c'est génial ce code. Pas besoin d'activeX cool...
Merci !

Commentaire de ouezon le 08/04/2006 16:06:29

Hello, je rencontre le même blème: Ton code est géniale mais une erreur  s'affiche chez moi.
Incompatibilité de type, et le débogguage se met sur
la fonction Init-paramet au niveau de JO1.
A +

Commentaire de djamelo le 07/06/2006 11:47:28

Slt, je c'est pas comment il faut faire pour ajouter se programme qui correspond parfaitement à se que je cherche dans mon projet VB. Est qu'il est possible de faire apparaître les deux formulaires sur ma pages VB???
Merci de repondre,

Commentaire de pasco05 le 18/02/2007 21:44:49

pas mal ton code juste un petit bug le Dclick ouvre le form canadrier seulement a la date du jour ??
sinon code propre et lite.

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,562 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales