VBA Excel [Semua versi] - Kontrol Kalender

pengantar

Kontrol kalender VBA telah berubah antara Excel 2003 dan Excel 2010. Versi yang lebih lama memiliki kontrol yang dinamai " Kalender " dan untuk versi baru itu disebut kontrol " DT Picker ". Masalah kompatibilitas dapat muncul saat Anda mencoba menggunakan:

buku kerja dengan kontrol Kalender pada versi baru Excel
buku kerja dengan DT Picker pada versi Excel sebelumnya.

Kekhawatiran lain terletak pada versi Microsoft Office yang digunakan. Beberapa konfigurasi perusahaan tidak memungkinkan akses ke kontrol DT Picker. Untuk memperbaiki ini, saya sarankan Anda membuat kontrol kalender Anda sendiri, menggunakan UserForm.

UserForm

UserForm akan berisi:

29 dan 31 tombol perintah untuk "Days".
Label "Pilihan Bulan Ini".
2 tombol ("") untuk bernavigasi di antara bulan.
Bulan dan tahun saat ini akan ditampilkan dalam "Keterangan" (judul) dari UserForm.
Semua kontrol dalam UserForm ini akan dibuat secara dinamis.

Mulai

Buka editor VBA Anda, buat UserForm baru dan ubah properti Name menjadi "Calendrier".

Salin kode di bawah ini dalam Modul UserForm:

 Opsi Explicit Private Sub UserForm_Initialize () Dim Obj Sebagai Kontrol Dim i Sebagai Integer, Mois As Integer, Annee As Integer Dim Cl As Classe1 'Création Changement de mois' LABEL Set Collect = Koleksi Baru Set Obj = Me.Controls.Add ("form .Label.1 ") Dengan Obj .Nama =" LbChoixMois ".Object.Caption =" Choix du mois: ".Left = 5 .Top = 5 .Tinggi = 70 .Tinggi = 10 Berakhir Dengan 'BOUTONS Atur Obj = Me. Controls.Add ("forms.CommandButton.1") Dengan Obj .Name = "MoisPrec" .Object.Caption = "" .Left = 95 .Top = 1 .Lebar = 20 .Tinggi = 20 Berakhir Dengan Set Cl = Kelas Baru1 Set Cl.Bouton = Obj Collect.Add Cl 'Création entête Jours de la semaine For i = 1 To 7 Set Obj = Me.Controls.Add ("forms.Label.1") Dengan Obj .Name = "Jour" & i .Object.Caption = UCase (Kiri (Format (DateSerial (2014, 9, i), "dddd"), 1)) .Left = 20 * (i - 1) + 5. Top = 25. Lebar = 20. Tinggi = 20. Tinggi = 10 Berakhir Dengan Selanjutnya saya boutons "jours" Mois = Bulan (Tanggal) MoisEnCours = Mois Annee = Tahun (Tanggal) AnneeEnCours = Penciptaan AnneeBoutonsJours Mois, Annee Jika Kiri (Format (Tanggal, "dd"), 1) = "0" Lalu Me.Controls ("Bouton" & Format (Tanggal, "d")). SetFocus Else Me.Controls ("Bouton" & Format (Tanggal, "dd")). SetFocus End Sub

Buat tombol

Jumlah hari bervariasi dari satu bulan ke bulan lainnya, jadi kami akan membuatnya secara dinamis. Untuk ini, prosedur yang kami butuhkan:

Hapus tombol lama
Buat tombol baru berdasarkan bulan dan tahun.

Buat modul (Sisipkan> Modul) dan salin kode di bawah ini:

 Opsi Eksplisit Publik Dengan Acara Bouton Sebagai MSForms.CommandButton Private Sub Bouton_Klik () Pilih Kasus Bouton.Kasus Nama "MoisPrec" MoisEnCours = MoisEnCours - 1 Jika MoisEnCours = 0 Maka MoisEnCours = 12 AnneeEnCours = AnneeEourCourEnourCourNou = = 1900 Kotak Pesan "Première année: 1900" Berakhir Jika Berakhir Jika Kasus "MoisSuiv" MoisEnCours = MoisEnCours + 1 Jika MoisEnCours = 13 Lalu MoisEnCours = 1 AnneeEnCours = AnneeEnCours + 1 End Jika Akhir Pilih CreationBoutCons

Modul Kelas

Kita perlu membuat modul kelas agar tombol perintah berfungsi.

Untuk menavigasi antara bulan:

 Opsi Eksplisit Publik WithEvents Btn As MSForms.CommandButton 'Procoror clic sur un bouton "jour" Private Sub Btn_Klik () Dim maDate As Date maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) l'action à effectuer lors d'un clic sur le bouton 'Pour entrer la date choisie dans une cellule et fermer l'Userform:' ActiveCell.Value = maDate 'Bongkar Calendrier MsgBox maDate End Sub' Affiche le nom du jour férié au survol du bouton par la souris Sub Pribadi Btn_MouseMove (ByVal Button Sebagai Integer, ByVal Shift As Integer, ByVal X Sebagai Single, ByVal Y As Single) Dim maDate As Date maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) Jika EstJourFerie (maDate) Atau Paques (Tahun (maDate)) = maDate Then Btn.ControlTipText = QuelFerie (maDate) End Sub

Modul kelas untuk hari-hari

 Opsi Eksplisit Publik WithEvents Btn As MSForms.CommandButton 'Procoror clic sur un bouton "jour" Private Sub Btn_Klik () Dim maDate As Date maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) l'action à effectuer lors d'un clic sur le bouton 'Pour entrer la date choisie dans une cellule et fermer l'Userform:' ActiveCell.Value = maDate 'Bongkar Calendrier MsgBox maDate End Sub' Affiche le nom du jour férié au survol du bouton par la souris Sub Pribadi Btn_MouseMove (ByVal Button Sebagai Integer, ByVal Shift As Integer, ByVal X Sebagai Single, ByVal Y As Single) Dim maDate As Date maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) Jika EstJourFerie (maDate) Atau Paques (Tahun (maDate)) = maDate Then Btn.ControlTipText = QuelFerie (maDate) End Sub

Mengelola hari libur nasional

Dalam modul standar yang dibuat sebelumnya, kami akan menambahkan tiga fungsi untuk mengidentifikasi hari libur.

Fungsi yang mengembalikan liburan sebagai string

 'Fonction qui retourne le jour férié id "String"' menggunakan les info-bulles au survol des jours fériés Fungsi Publik QuelFerie (Jour As Date) Sebagai String Dim maDate As Date Dim a As Integer, m As Integer, j As Integer maDate = Paques (Tahun (Jour)) Jika Jour = maDate Lalu QuelFerie = "Dimanche de Pâques": Keluar Fungsi Jika Jour = CDate (maDate + 1) Kemudian QuelFerie = "Lundi de Pâques": Keluar Fungsi Jika Jour = CDate (maDate + 50) Kemudian QuelFerie = "Lundi de Pentecôte": Keluar Dari Fungsi Jika Jour = CDate (maDate + 39) Kemudian QuelFerie = "Jeudi de l'ascension": Fungsi Keluar a = Tahun (Jour): m = Bulan (Jour): j = Hari (Jour) Pilih Case m * 100 + j Case 101 QuelFerie = "1er Janvier": Keluar dari Function Function 501 QuelFerie = "1er Mai": Keluar dari Function Function 508 QuelFerie = "8 Mai": Exit Function Case 714 QuelFerie = " 14 Juillet ": Exit Function Case 815 QuelFerie =" 15 Août ": Exit Function Case 1101 QuelFerie =" 1er Novembre ": Exit Function Case 1111 QuelFerie =" 11 Novembre ": Exit Function Case 1225 QuelFerie =" Noël ": Keluar dari Fungsi Akhir Pilih Fungsi Akhir

Fungsi yang mengidentifikasi hari libur umum

 'SUMBER:' //blog.developpez.com/philben/p11458/vba-access/sagit-il-dun-jour-ferie Fungsi Publik EstJourFerie (ByVal laDate As Date, Opsional ByVal EstPentecoteFerie As Boolean = True) As Boolean 'Détermine si la date passée en argument est un jour férié (en France) ou non: '101 = 1er Janvier - 501 = 1er Mai - 508 = 8 Mai - 714 = 14 Juillet' 815 = 15 Août - 1101 = 1er Novembre - 1111 = 11 Novembre - 1225 = 25 Décembre 'dPa = Lundi de Pâques - dAs = Jeudi de l'Ascension - dPe = Lundi de Pentecôte' Remarque: Le lundi de Pentecôte est un jour férié mais parfois non chômé (EstPentecoteFerie = menara palsu) 'Philben - v1.0 - 2012 - Bebas untuk menggunakan Statis Annee Sebagai Integer, dPa Sebagai Tanggal, dA Sebagai Tanggal, dPe Sebagai Tanggal, bPe Sebagai Boolean Dim Bilangan Bulat Sebagai Bilangan Bulat, m Sebagai Bilangan Bulat, j Sebagai Bilangan Bulat = Tahun (laDate) : m = Bulan (laDate): j = Hari (laDate) Pilih Kasus m * 100 + j Kasus 101, 501, 508, 714, 815, 1101, 1111, 1225 EstJourFerie = True Case 323 Ke 614 '323: Date mini Lundi de Pâques - 614: Dat e maxi Lundi de Pentecôte Jika Annee Atau EstPentecoteFerie bPe Kemudian Annee = a: dPa = Paques (a) + 1: dA = dPa + 38 bPe = EstPentecoteFerie: Jika bPe Kemudian dPe = dPa + 49 Lain dPe = # 1/1 / 100 # End Jika Select Case DateSerial (a, m, j): Case dPa, dAs, dPe: EstJourFerie = True: End Select End Select End Function