Tinh ngày trên Form (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Excel365

Thành viên tích cực
Tham gia
29/10/10
Bài viết
865
Được thích
127
Giới tính
Nam
Nhờ các anh chị giup em viết code tình ngày trên form. Như file đính kèm
Trân trọng
 

File đính kèm

Theo đúng kết cấu Form của bạn thì dùng thủ tục Textbox_Change(). Tuy nhiên do có 2 yêu cầu cùng lúc như bạn ghi trong file sẽ dẫn đến lặp vòng.
 
Upvote 0

File đính kèm

Upvote 0
Nhờ các anh chị giup em viết code tình ngày trên form. Như file đính kèm
Trân trọng
Theo bạn thì nếu tôi nghỉ 1 ngày, tức ngày hôm nay tôi nghỉ, thì hết ngày hôm nay, mai mới đi làm thì Số ngày = 1 và Ngày kết thúc sẽ bằng ngày bắt đầu, chứ sao Ngày kết thúc = Ngày bắt đầu + 1 được bạn? Như thế đã là 2 ngày rồi còn gì?
 
Upvote 0
1) Cách tính ngày của tôi là tính luôn ngày bắt đầu vì thế nếu Ngày bắt đầu là 1/1/2014 và nếu số ngày nghỉ là 2 thì Đến hết ngày sẽ là 2/1/2014. Bạn ngẫm lại có đúng không, bởi phải tính luôn ngày bắt đầu chứ! Nếu bạn không muốn vậy, bạn có thể thấy trong các thủ tục chỗ nào tính toán có +1 hay -1 bạn xóa nó đi.

2) Tính theo mọi yêu cầu của bạn.

3) Khi dùng chuột đặt con trỏ vào Ngày bắt đầu hay Ngày kết thúc thì sẽ có một Calendar hiện ra, bạn chỉ việc click chọn ngày trong đó để nhập nhanh ngày tháng. Bạn không thể gõ trực tiếp được đâu nhé!

4) Khi nhập ngày kết thúc, nếu kết quả của Số ngày bằng 0 hay một số âm, ngay lập tức Số ngày sẽ hiển thị màu xanh để báo cho bạn biết sự cố này!

attachment.php


5) Khi bấm nút Refresh có nghĩa rằng Ngày bắt đầu được nhập mặc định là ngày hiện hành, Số ngày, Ngày kết thúc sẽ được xóa.

6) Không dùng sự kiện SheetActive để show form mà dùng nút lệnh trên sheet.

7) Toàn bộ code trong form:

Mã:
Private priStartDate As Boolean, priClear As Boolean
Private Const MauTrang As Long = &H80000005
Private Const MauXanh As Long = &HFF00&


''*************************************************
Private Sub UserForm_Initialize()
    Calendar1 = Date
    priClear = True
    TxtBatdau = Date
    priClear = False
End Sub
''*************************************************


Private Sub TxtSongay_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub


Private Sub TxtSongay_Change()
    If priClear Then Exit Sub
    priClear = True
    With TxtSongay
        If Val(.Text) >= 0 And .BackColor <> MauTrang Then
            .BackColor = MauTrang
        End If
        If Val(.Text) = 0 Then
            TxtKetthuc = ""
        Else
            TxtKetthuc = CDate(TxtBatdau) + Val(.Text) [SIZE=4][B][COLOR=#0000FF]- 1[/COLOR][/B][/SIZE]
        End If
    End With
    priClear = False
End Sub
''*************************************************


Private Sub TxtBatdau_Enter()
    priStartDate = True
End Sub


Private Sub TxtBatdau_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With Calendar1
        .Top = TxtBatdau.Top + TxtBatdau.Height
        .Left = TxtBatdau.Left
        .Visible = True
        .Value = CDate(TxtBatdau)
    End With
End Sub


Private Sub TxtBatdau_Change()
    If priClear Or TxtSongay = "" Then Exit Sub
    priClear = True
    TxtKetthuc = CDate(TxtBatdau) + Val(TxtSongay) [SIZE=4][B][COLOR=#0000ff]- 1[/COLOR][/B][/SIZE]
    priClear = False
End Sub
''*************************************************


Private Sub TxtKetthuc_Enter()
    priStartDate = False
End Sub


Private Sub TxtKetthuc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With Calendar1
        .Top = TxtKetthuc.Top + TxtKetthuc.Height
        .Left = TxtKetthuc.Left
        .Visible = True
        If TxtKetthuc > "" Then
            .Value = CDate(TxtKetthuc)
        Else
            .Value = Date
        End If
    End With
End Sub


Private Sub TxtKetthuc_Change()
    If priClear Then Exit Sub
    priClear = True
    With TxtSongay
        .Text = CDate(TxtKetthuc) - CDate(TxtBatdau)[SIZE=4][COLOR=#0000ff][B] + 1[/B][/COLOR][/SIZE]
        If Val(.Text) < 1 Then
            .BackColor = MauXanh
        Else
            .BackColor = MauTrang
        End If
    End With
    priClear = False
End Sub
''*************************************************


Private Sub Calendar1_Click()
    If priStartDate Then
        With TxtBatdau
            .Text = Calendar1
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Else
        With TxtKetthuc
            .Text = Calendar1
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    End If
    Calendar1.Visible = False
End Sub
''*************************************************


Private Sub CommandButton1_Click()
    priClear = True
    Calendar1 = Date
    TxtBatdau = Date
    TxtKetthuc = ""
    Calendar1.Visible = False
    TxtSongay = ""
    TxtSongay.SetFocus
    TxtSongay.BackColor = MauTrang
    priClear = False
End Sub
 

File đính kèm

  • Picture1.jpg
    Picture1.jpg
    27.3 KB · Đọc: 50
  • TinhNgay.xlsm
    TinhNgay.xlsm
    28.8 KB · Đọc: 21
Upvote 0
1) Cách tính ngày của tôi là tính luôn ngày bắt đầu vì thế nếu Ngày bắt đầu là 1/1/2014 và nếu số ngày nghỉ là 2 thì Đến hết ngày sẽ là 2/1/2014. Bạn ngẫm lại có đúng không, bởi phải tính luôn ngày bắt đầu chứ! Nếu bạn không muốn vậy, bạn có thể thấy trong các thủ tục chỗ nào tính toán có +1 hay -1 bạn xóa nó đi.

2) Tính theo mọi yêu cầu của bạn.

3) Khi dùng chuột đặt con trỏ vào Ngày bắt đầu hay Ngày kết thúc thì sẽ có một Calendar hiện ra, bạn chỉ việc click chọn ngày trong đó để nhập nhanh ngày tháng. Bạn không thể gõ trực tiếp được đâu nhé!

4) Khi nhập ngày kết thúc, nếu kết quả của Số ngày bằng 0 hay một số âm, ngay lập tức Số ngày sẽ hiển thị màu xanh để báo cho bạn biết sự cố này!

attachment.php


5) Khi bấm nút Refresh có nghĩa rằng Ngày bắt đầu được nhập mặc định là ngày hiện hành, Số ngày, Ngày kết thúc sẽ được xóa.

6) Không dùng sự kiện SheetActive để show form mà dùng nút lệnh trên sheet.

7) Toàn bộ code trong form:

Mã:
Private priStartDate As Boolean, priClear As Boolean
Private Const MauTrang As Long = &H80000005
Private Const MauXanh As Long = &HFF00&


''*************************************************
Private Sub UserForm_Initialize()
    Calendar1 = Date
    priClear = True
    TxtBatdau = Date
    priClear = False
End Sub
''*************************************************


Private Sub TxtSongay_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub


Private Sub TxtSongay_Change()
    If priClear Then Exit Sub
    priClear = True
    With TxtSongay
        If Val(.Text) >= 0 And .BackColor <> MauTrang Then
            .BackColor = MauTrang
        End If
        If Val(.Text) = 0 Then
            TxtKetthuc = ""
        Else
            TxtKetthuc = CDate(TxtBatdau) + Val(.Text) [SIZE=4][B][COLOR=#0000FF]- 1[/COLOR][/B][/SIZE]
        End If
    End With
    priClear = False
End Sub
''*************************************************


Private Sub TxtBatdau_Enter()
    priStartDate = True
End Sub


Private Sub TxtBatdau_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With Calendar1
        .Top = TxtBatdau.Top + TxtBatdau.Height
        .Left = TxtBatdau.Left
        .Visible = True
        .Value = CDate(TxtBatdau)
    End With
End Sub


Private Sub TxtBatdau_Change()
    If priClear Or TxtSongay = "" Then Exit Sub
    priClear = True
    TxtKetthuc = CDate(TxtBatdau) + Val(TxtSongay) [SIZE=4][B][COLOR=#0000ff]- 1[/COLOR][/B][/SIZE]
    priClear = False
End Sub
''*************************************************


Private Sub TxtKetthuc_Enter()
    priStartDate = False
End Sub


Private Sub TxtKetthuc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With Calendar1
        .Top = TxtKetthuc.Top + TxtKetthuc.Height
        .Left = TxtKetthuc.Left
        .Visible = True
        If TxtKetthuc > "" Then
            .Value = CDate(TxtKetthuc)
        Else
            .Value = Date
        End If
    End With
End Sub


Private Sub TxtKetthuc_Change()
    If priClear Then Exit Sub
    priClear = True
    With TxtSongay
        .Text = CDate(TxtKetthuc) - CDate(TxtBatdau)[SIZE=4][COLOR=#0000ff][B] + 1[/B][/COLOR][/SIZE]
        If Val(.Text) < 1 Then
            .BackColor = MauXanh
        Else
            .BackColor = MauTrang
        End If
    End With
    priClear = False
End Sub
''*************************************************


Private Sub Calendar1_Click()
    If priStartDate Then
        With TxtBatdau
            .Text = Calendar1
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Else
        With TxtKetthuc
            .Text = Calendar1
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    End If
    Calendar1.Visible = False
End Sub
''*************************************************


Private Sub CommandButton1_Click()
    priClear = True
    Calendar1 = Date
    TxtBatdau = Date
    TxtKetthuc = ""
    Calendar1.Visible = False
    TxtSongay = ""
    TxtSongay.SetFocus
    TxtSongay.BackColor = MauTrang
    priClear = False
End Sub
Anh cho em hỏi, làm sao để mình có thể thoát khỏi tờ lịch khi chuột di chuyển ra khỏi textbox, hoặc click chuột ra ngoài vùng trống trên form (không cần phải bấm nút Refresh)
 
Upvote 0
Anh cho em hỏi, làm sao để mình có thể thoát khỏi tờ lịch khi chuột di chuyển ra khỏi textbox, hoặc click chuột ra ngoài vùng trống trên form (không cần phải bấm nút Refresh)

Thì thêm 1 nút lệnh nữa đi bạn!

Mã:
Private Sub CommandButton2_Click()
    Calendar1.Visible = False
End Sub

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu như vậy thì mình phải vẽ thêm 1 cái CommanButton hả anh
Ý của em là di chuyển chuột ra khỏi tờ lịch thì tự động thoát form lịch
Nếu không muốn vẽ thêm thì tại TxtSongay bạn thêm sự kiện Enter này:

Mã:
Private Sub [COLOR=#ff8c00][B]TxtSongay[/B][/COLOR]_Enter()
    Calendar1.Visible = False
End Sub

Nếu có phát sinh các TextBox khác (ngoài 3 cái có sẳn) thì bạn lại tiếp tục copy sự kiện trên và sửa lại theo tên của các tbx đó (thay chữ màu cam).
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom