[Chia sẻ: Access] Phần 1 Tạo danh sách ngày nghỉ trên forms bằng VBA and SQL (2 người xem)

[cuongtokyo0240]

Chào anh em
Hôm nay mình chia sẻ 1 cách tạo danh sách ngày tháng đánh dấu ngày nghỉ theo yêu cầu bằng VBA và SQL
Phần 1 Mình sẽ giới thiệu về Code VBA trước
Phần 2 Sẽ giới thiệu cách làm sau.
Dưới đây là code Vba phần Main chính . (Các module mình sẽ update sau)
(Ngoài ra hệ thống code này nó được tối giản đến mức các nút bấm ,tắt mở, xóa, co dãn chiều cao độ rộng đc gói gọn hết trong các module . Khi đó bạn viết vài trăm cái forms hay report nó rất ngắn )
**Chương trình này nó hơi dài nên mình ko update cho các bạn dc 1 lúc*
*Hình ảnh mô phỏng cái form mình đang làm nhé

Option Compare Database
Option Explicit
Dim cmd As ADODB.Command
Dim par(3) As ADODB.Parameter
Dim i As Integer
Dim StrNgayNghi As String

Private Const AUTH_FRM = "MENU_Name"
Private Const AUTH_CTL = "Forms_Name"

Private Const SP_FRM As String = "Stored Procedures Name"
Private Const UNIQUE_TABLE As String = "Table"

Private Const RESYNC_COMMAND As String = "Resync command"

Private Sub Form_Open(Cancel As Integer)
Set Base = New BaseMasterForm
With Base
.AuthFrm = AUTH_FRM
.AuthCtl = AUTH_CTL
.Bind Me
End With
Me!chu_nhat = True
Me!T2 = False
Me!T3 = False
Me!T4 = False
Me!T5 = False
Me!T6 = False
Me!T7 = False
Me!TimKiemNgayThang01.SetFocus
Call FrmRequery
End Sub
'---Tao danh sach ngay thang
'---・Click
Private Sub Create_Date_Click()
On Error GoTo Err_Create_Date
If IsNull(Me!TimKiemNgayThang01) Or IsNull(Me!TimKiemNgayThang02) Then
MsgBox "Vui long ch? ??nh ph?m vi ngay", vbCritical, "error"
Me!TimKiemNgayThang01.SetFocus
Exit Sub
End If
'cai dat ngay thang trong SQL SERVER

StrNgayNghi = ""
Kyujitu (Me!chu_nhat)
Kyujitu (Me!T2)
Kyujitu (Me!T3)
Kyujitu (Me!T4)
Kyujitu (Me!T5)
Kyujitu (Me!T6)
Kyujitu (Me!T7)

' KiemTraCoppy
If MsgBox("Create_Data", vbYesNo + vbQuestion, "KiemTraCoppy") <> vbYes Then
Exit Sub
End If

' KhoiDongCoppy
Set cmd = New ADODB.Command
For i = 0 To 2
Set par(i) = New ADODB.Parameter
Next i
'
With cmd
.ActiveConnection = cn
.CommandType = adCmdStoredProc
.CommandText = "dbo.SPMCreate_Date"
Set par(0) = .CreateParameter(, adDate, adParamInput, , Me!TimKiemNgayThang01)
.Parameters.Append par(0)
Set par(1) = .CreateParameter(, adDate, adParamInput, , Me!TimKiemNgayThang02)
.Parameters.Append par(1)
Set par(2) = .CreateParameter(, adVarChar, adParamInput, 7, StrNgayNghi)
.Parameters.Append par(2)
End With
'
cmd.Execute
Set cmd = Nothing
For i = 0 To 2
Set par(i) = Nothing
Next i
'
Call FrmRequery
MsgBox "Hoan thanh tao bang Date, Vui long kiem tra lai", vbInformation, "CoppyXong"
Exit_Create_Date:
Exit Sub
Err_Create_Date:
MsgBox ERR.Description

Resume Exit_Create_Date
End Sub
'---TimKiemNgayThang01
Private Sub TimKiemNgayThang01_AfterUpdate()
If IsNull(Me!TimKiemNgayThang02) Then
Me!TimKiemNgayThang02.SetFocus
Else
Call FrmRequery
End If
End Sub

'---TimKiemNgayThang02
Private Sub TimKiemNgayThang02_AfterUpdate()
If IsNull(Me!TimKiemNgayThang01) Then
Me!TimKiemNgayThang01.SetFocus
Else
Call FrmRequery
End If
End Sub

'---Cat dat NgayNghi

Private Sub Caidat_NgayNghi_AfterUpdate()
If Me!NgayNghi = "○" Then
Me!khongmongaynghi = "○"
End If
End Sub

Private Sub FrmRequery()
Dim prm As New Dictionary
prm.Add "@TimKiemNgayThang01", Me.TimKiemNgayThang01
prm.Add "@TimKiemNgayThang02", Me.TimKiemNgayThang02

Call SYS_Form.SetRecordset( _
Me _
, SP_FRM _

, prm _

)
Me.UniqueTable = UNIQUE_TABLE

Me.ResyncCommand = RESYNC_COMMAND
End Sub
Private Sub NgayNghi(Yobi)
If Yobi = True Then
StrNgayNghi = StrNgayNghi & "1"
Else
StrNgayNghiYasumi = StrNgayNghi & "0"
End If
End Sub

 

[hoanganhvo2612]

Chào anh em
Hôm nay mình chia sẻ 1 cách tạo danh sách ngày tháng đánh dấu ngày nghỉ theo yêu cầu bằng VBA và SQL
Phần 1 Mình sẽ giới thiệu về Code VBA trước
Phần 2 Sẽ giới thiệu cách làm sau.
Dưới đây là code Vba phần Main chính . (Các module mình sẽ update sau)
(Ngoài ra hệ thống code này nó được tối giản đến mức các nút bấm ,tắt mở, xóa, co dãn chiều cao độ rộng đc gói gọn hết trong các module . Khi đó bạn viết vài trăm cái forms hay report nó rất ngắn )
**Chương trình này nó hơi dài nên mình ko update cho các bạn dc 1 lúc*
*Hình ảnh mô phỏng cái form mình đang làm nhé

Option Compare Database
Option Explicit
Dim cmd As ADODB.Command
Dim par(3) As ADODB.Parameter
Dim i As Integer
Dim StrNgayNghi As String

Private Const AUTH_FRM = "MENU_Name"
Private Const AUTH_CTL = "Forms_Name"

Private Const SP_FRM As String = "Stored Procedures Name"
Private Const UNIQUE_TABLE As String = "Table"

Private Const RESYNC_COMMAND As String = "Resync command"

Private Sub Form_Open(Cancel As Integer)
Set Base = New BaseMasterForm
With Base
.AuthFrm = AUTH_FRM
.AuthCtl = AUTH_CTL
.Bind Me
End With
Me!chu_nhat = True
Me!T2 = False
Me!T3 = False
Me!T4 = False
Me!T5 = False
Me!T6 = False
Me!T7 = False
Me!TimKiemNgayThang01.SetFocus
Call FrmRequery
End Sub
'---Tao danh sach ngay thang
'---・Click
Private Sub Create_Date_Click()
On Error GoTo Err_Create_Date
If IsNull(Me!TimKiemNgayThang01) Or IsNull(Me!TimKiemNgayThang02) Then
MsgBox "Vui long ch? ??nh ph?m vi ngay", vbCritical, "error"
Me!TimKiemNgayThang01.SetFocus
Exit Sub
End If
'cai dat ngay thang trong SQL SERVER

StrNgayNghi = ""
Kyujitu (Me!chu_nhat)
Kyujitu (Me!T2)
Kyujitu (Me!T3)
Kyujitu (Me!T4)
Kyujitu (Me!T5)
Kyujitu (Me!T6)
Kyujitu (Me!T7)

' KiemTraCoppy
If MsgBox("Create_Data", vbYesNo + vbQuestion, "KiemTraCoppy") <> vbYes Then
Exit Sub
End If

' KhoiDongCoppy
Set cmd = New ADODB.Command
For i = 0 To 2
Set par(i) = New ADODB.Parameter
Next i
'
With cmd
.ActiveConnection = cn
.CommandType = adCmdStoredProc
.CommandText = "dbo.SPMCreate_Date"
Set par(0) = .CreateParameter(, adDate, adParamInput, , Me!TimKiemNgayThang01)
.Parameters.Append par(0)
Set par(1) = .CreateParameter(, adDate, adParamInput, , Me!TimKiemNgayThang02)
.Parameters.Append par(1)
Set par(2) = .CreateParameter(, adVarChar, adParamInput, 7, StrNgayNghi)
.Parameters.Append par(2)
End With
'
cmd.Execute
Set cmd = Nothing
For i = 0 To 2
Set par(i) = Nothing
Next i
'
Call FrmRequery
MsgBox "Hoan thanh tao bang Date, Vui long kiem tra lai", vbInformation, "CoppyXong"
Exit_Create_Date:
Exit Sub
Err_Create_Date:
MsgBox ERR.Description

Resume Exit_Create_Date
End Sub
'---TimKiemNgayThang01
Private Sub TimKiemNgayThang01_AfterUpdate()
If IsNull(Me!TimKiemNgayThang02) Then
Me!TimKiemNgayThang02.SetFocus
Else
Call FrmRequery
End If
End Sub

'---TimKiemNgayThang02
Private Sub TimKiemNgayThang02_AfterUpdate()
If IsNull(Me!TimKiemNgayThang01) Then
Me!TimKiemNgayThang01.SetFocus
Else
Call FrmRequery
End If
End Sub

'---Cat dat NgayNghi

Private Sub Caidat_NgayNghi_AfterUpdate()
If Me!NgayNghi = "○" Then
Me!khongmongaynghi = "○"
End If
End Sub

Private Sub FrmRequery()
Dim prm As New Dictionary
prm.Add "@TimKiemNgayThang01", Me.TimKiemNgayThang01
prm.Add "@TimKiemNgayThang02", Me.TimKiemNgayThang02

Call SYS_Form.SetRecordset( _
Me _
, SP_FRM _

, prm _

)
Me.UniqueTable = UNIQUE_TABLE

Me.ResyncCommand = RESYNC_COMMAND
End Sub
Private Sub NgayNghi(Yobi)
If Yobi = True Then
StrNgayNghi = StrNgayNghi & "1"
Else
StrNgayNghiYasumi = StrNgayNghi & "0"
End If
End Sub

Bạn nên nêu rõ mục đích của công việc hơn nữa và tốt nhất là mô tả chương trình bằng hình ảnh hoặc video để mọi người có thể mường tượng được và biết được tính ứng dụng của nó