Sau khi đã hoàn thành khung và giao tiếp, bạn gõ Alt + F11, Ctrl +R sau đó chèn Insert Module vào tệp Project của bạn Tiến hành lập trình ví dụ:
Option Explicit
Sub Aut
pen()
' Lệnh tự động thực hiện khi mở tệp
Dim quangcao
Dim hoi As Integer
' Đổi tên tiêu đề "Microsoft Excel" thành tiêu đề chương trình của mình
Application.Caption = "Xem đẻ con trai hay con gái"
' Không dùng tiêu đề của cửa sổ tài liệu
ThisWorkbook.Windows(1).Caption = ""
'Làm việc với Sheet "Giao tiếp
Sheets("Giao tiếp").Select
Range("A1").Select
'Che giấu tất cả những gì nhìn thấy thông thường như các thanh công
'cụ, thanh công thức, thanh trạng thái...
' Đánh theo máy của bạn vì có thể khác máy của tôi
Toolbars(1).Visible = False
Toolbars(2).Visible = False
Toolbars(9).Visible = False
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
.DisplayOutline = False
.DisplayZeros = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
Application.DisplayNoteIndicator = False
'ActiveWindow.Visible = False
'Hiện hộp thoại hỏi
hoi = MsgBox("Bạn có muốn xem mình sinh con trai hay gái không ? Nếu muốn nhấn YES, không nhấn NO.", 4132, "Hỏi xem có xem không?")
'Nếu người dùng đồng ý
If hoi = 6 Then
'Thực hiện thủ tục nhapngay rồi thủ tục Batdau
nhapngay
batdau
Else
'Nếu người dùng không đồng ý xem
Application.Caption = "Microsoft Excel" 'Trả lại tên cho Excel
'Cho hiện lại những gì đã che giấu
Toolbars(1).Visible = True
Toolbars(2).Visible = True
' ActiveWindow.Visible = True
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = True
.DisplayHeadings = True
.DisplayOutline = True
.DisplayZeros = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
End With
Application.DisplayNoteIndicator = True
'Cất
ActiveWorkbook.Save
'Thoát khỏi
Application.Quit
End If
End Sub
Sub batdau()
'Thủ tục bắt đầu, khai báo các biến sử dụng
Dim tuoi
Dim hang
Dim cot As Integer
Dim thoi As Boolean
Dim contrai
Dim hoi
Dim nhactuoi
Dim ten
Dim dien
thoi = True
While thoi
'Nhận tên người xem
ten = InputBox("Xin cho biết tên người cần xem:", "Nhập tên")
If ten = "" Then
dien = "Bạn này giấu tên"
Else
dien = ten
End If
'Điền tên người xem vào ô A3
Range("A3").Select
ActiveCell.FormulaR1C1 = dien
z:
'Nhắc nhập tuổi người cần xem
nhactuoi = "Xin cho biết tuổi của bạn " + ten + " khi thụ thai." + Chr(13) + "Chú ý là tuổi theo tuổi mụ." + Chr(13) + "VD: Nếu bạn sinh 1980, thì bạn " + Str(Year(Date) - 1979) + " tuổi."
tuoi = InputBox(nhactuoi, "Nhập tuổi", 18)
If tuoi = "" Then
MsgBox ("Bạn chưa nhập tuổi, tạm coi khi thụ thai tuổi bạn " + ten + " là 18.")
tuoi = 18
End If
'Nếu nhập sai tuổi, yêu cầu nhập lại
If Not IsNumeric(tuoi) Then
MsgBox ("Xin nhập lại bằng số.")
GoTo z:
End If
'Nếu tuổi quá giới hạn cho phép
If (tuoi < 18) Or (tuoi > 44) Then
'Thông báo khi người xem quá nhỏ tuổi
If (tuoi < 18) Then
MsgBox ("Xin lỗi, tại sao em " + ten + " nhỏ tuổi mà lại dại dột thế? Máy từ chối xem cho trường hợp này, nên đặt vòng cho em " + ten)
Else
'Thông báo khi người xen quá lớn tuổi
MsgBox ("Xin lỗi, tại sao bà " + ten + " lớn tuổi như thế mà lại có con là thế nào? Máy từ chối xem cho trường hợp này, xin bà " + ten + " đừng đẻ nữa.")
End If
Else
y:
'Nhập tháng thụ thai vào biến hang để tra bảng
hang = InputBox("Xin cho biết bạn " + ten + " thụ thai vào tháng nào:" + Chr(13) + "(Xin lưu ý tháng nhập này là tháng âm lịch)", "Nhập tháng thụ thai", 1)
If hang = "" Then
'Nếu không nhập, coi luôn là tháng 1
MsgBox ("Bạn chưa nhập tháng thụ thai, tạm coi là tháng 1.")
hang = 1
End If
If Not IsNumeric(hang) Then
'Nếu nhập sai, yêu cầu nhập lại
MsgBox ("Xin nhập lại bằng số.")
GoTo y:
End If
'Nếu cố tình nhập sai tháng
If (hang > 12) Or (hang < 0) Then
Do While (hang > 12) Or (hang < 0)
MsgBox ("Mỗi năm chỉ có 12 tháng, bạn đừng đãng trí quá mức như vậy.")
hang = InputBox("Xin cho biết tháng mà bạn " + ten + " thụ thai:", "Nhập tháng thụ thai")
Loop
End If
'Xác định cột cần tra
cot = tuoi - 17
Sheets("Giao tiếp").Select
'Tra trong bảng gốc
contrai = Sheets("Bảng gốc").Cells(hang, cot).Value
If contrai = "T" Then
'Nếu giá trị là T
MsgBox ("Bạn " + ten + " sẽ sinh con trai. Xin chúc mừng !")
Else
MsgBox ("Xin bạn " + ten + " đừng buồn. Bạn sẽ sinh con gái. Bạn vẫn có thể đẻ tiếp con trai ở những lần sau, bạn " + ten + " ạ.")
End If
'Gọi thủ tục Cocontrai
Cocontrai (cot)
'Hỏi xem nữa không
hoi = MsgBox("Xem nữa không ? Nếu xem nữa nhấn YES, không xem nữa nhấn NO.", 4132, "Hỏi xem có xem nữa không ?")
If hoi = 7 Then
thoi = False
End If
End If
Wend
'Thông báo trước khi thoát
MsgBox ("Đây chỉ là chương trình thử nghiệm chỉ đúng khi bạn sinh hoạt, ăn uống bình thường. Xin cám ơn.")
Application.Caption = "Microsoft Excel" 'Trả lại tên cho Excel
'Cho hiện lại những gì đã giấu
Toolbars(1).Visible = True
Toolbars(2).Visible = True
ActiveWindow.Visible = True
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = True
.DisplayHeadings = True
.DisplayOutline = True
.DisplayZeros = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
End With
Application.DisplayNoteIndicator = True
ActiveWorkbook.Save
'Thoát
Application.Quit
End Sub
Sub Cocontrai(cot As Integer)
'Thông báo những tháng có con trai với tuổi người phụ nữ
Dim i As Integer
Dim kq
kq = "Với tuổi " + Str(cot + 17) + " thì thụ thai vào các tháng:"
For i = 2 To 12
If Sheets("Bảng gốc").Cells(i, cot) = "T" Then
kq = kq + Str(i) + ","
End If
Next
kq = Left(kq, Len(kq) - 1)
MsgBox (kq + " sẽ có con trai. Các tháng còn lại sẽ sinh con gái.")
End Sub
Function thu(ngay As Date) As String
'Hàm trả về là thứ trong tuần khi biết ngày
Dim kq
Select Case WeekDay(ngay)
Case 1
kq = "Chủ nhật"
Case 2
kq = "Thứ hai"
Case 3
kq = "Thứ ba"
Case 4
kq = "Thứ tư"
Case 5
kq = "Thứ năm"
Case 6
kq = "Thứ sáu"
Case 7
kq = "Thứ bảy"
End Select
thu = kq
End Function
Sub nhapngay()
'Thủ tục chỉnh ngày hệ thống
Dim Co
Dim Ngaymoi
Co = MsgBox("Ngày hôm nay là: " + thu(Date) + " ngày " + Format(Date, "dd/mm/ yyyy") + Chr(13) + "Bạn có muốn chỉnh lại không ?", 292, "Chỉnh ngày trước khi xem")
If Co = 6 Then
n:
Ngaymoi = Format(InputBox("Nhập ngày mới:", "Nhập ngày", Date), "dd/mm/yyyy")
If Ngaymoi <> "" Then
If Not IsDate(Ngaymoi) Then
MsgBox ("Nhập sai ngày. Xin nhập lại.")
GoTo n:
End If
Date = Ngaymoi
End If
End If
Application.MaxChange = 0.001
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate
End Sub
Bạn thân mến, trên đây là toàn bộ chương trình mẫu Xem sinh con trai hay gái mà tôi gửi đến tặng cho bạn. Tuy nhiên, bạn có thể sử dụng hiểu biết của mình để tạo thành các Form hay giao tiếp cho thật đẹp. Còn chiến lược, cũng như các phần đề cập
. Bạn chương trình hoàn chỉnh về đề tài này để mình so sánh mình đã sai ở đâu khi viết chương trình nha bạn.
