我有一个带有日历的表单,我想选择日历中的日期并点击打印按钮,结果是日历中选择的日期列表,打印出来。
示例:
我选择第1,2,16和17天,因此打印结果为:
1 September 2014
2 September 2014
16 September 2014
17 September 2014
这是"我的" vba代码:
Option Explicit
Option Compare Database
Const constShaded = 12632256 ' Shaded text box
Const constUnshaded = 16777215 ' Unshaded text box
Const constBackground = -2147483633 ' Background color for form (for unused textboxes)
Private Sub btnNextMonth_Click()
Dim ReferenceDate As Date
Dim NewDate As Date
' Load the current date from the form
ReferenceDate = Me.txtCalendarHeading
' Add 1 month to the date
NewDate = DateAdd("m", 1, ReferenceDate)
RefreshCalendar DatePart("m", NewDate), DatePart("yyyy", NewDate)
End Sub
Private Sub btnPrevMonth_Click()
Dim ReferenceDate As Date
Dim NewDate As Date
' Load the current date from the form
ReferenceDate = Me.txtCalendarHeading
' Subtract 1 month from the date
NewDate = DateAdd("m", -1, ReferenceDate)
RefreshCalendar DatePart("m", NewDate), DatePart("yyyy", NewDate)
End Sub
Private Sub CalendarOverlay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Row As Integer
Dim Col As Integer
Dim TextBoxIndex As Integer
Dim DayIndex As Integer
Dim strNum As String
Dim ctl As Control
Dim intYear As Integer
Dim intMonth As Integer
Dim intMaxDays As Integer
' MsgBox "Button Mouse Down - X: " & X & " Y: " & Y ' <== Use this to figure out dimensions
Const ButtonWidth = 3045 ' Maximum X value (found by experimenting with MsgBox enabled)
Const ButtonHeight = 2025 ' Maximum Y value (found by experimenting with MsgBox enabled)
' Convert X and Y to Row, Col equivalents on the table
Col = Int(X / (ButtonWidth / 7)) + 1 ' Divide width across 7 days
Row = Int(Y / (ButtonHeight / 6)) + 0 ' Divide height across 6 rows (for the calendar)
' MsgBox "Button Mouse Down - Col: " & Col & " Row: " & Row ' Debugging statement
' Calculate the index and figure out which text box
TextBoxIndex = Row * 7 + Col
' Test to see if it is a day in the month
DayIndex = TextBoxIndex - Weekday(Me.txtCalendarHeading) + 1
intMaxDays = Day(DateAdd("d", -1, DateAdd("m", 1, Me.txtCalendarHeading)))
If (DayIndex >= 1) And (DayIndex <= intMaxDays) Then
' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
strNum = Right("00" & TextBoxIndex, 2)
Set ctl = Me("CalDay" & strNum) ' Note: similar to Me.Caldayxx, but allows a string
' Toggle shading -- Just for demonstration
If ctl.BackColor = constUnshaded Then
ctl.BackColor = constShaded
Else
ctl.BackColor = constUnshaded
End If
' MsgBox the click -- Just for demonstration
intYear = Year(Me.txtCalendarHeading)
intMonth = Month(Me.txtCalendarHeading)
MsgBox "Clicked on " & DateSerial(intYear, intMonth, DayIndex)
End If
End Sub
Private Sub Form_Load()
' Call the refresh procedure
' Use the current date to start
RefreshCalendar DatePart("m", Date), DatePart("yyyy", Date)
End Sub
Public Function RefreshCalendar(intMonth As Integer, intYear As Integer)
' Initialize the calendar grid
ClearCalendar
' Set the date into the Calendar Heading
' Note this date is always the first of the displayed month (but field only shows month/year)
Me.txtCalendarHeading = DateSerial(intYear, intMonth, 1)
' Add numbers to the calendar
NumberCalendar
End Function
Private Sub ClearCalendar()
Dim TextBoxIndex As Integer
Dim strNum As String
Dim ctlCalendar As Control
Dim ctlInitial As Control
' Initialize the calendar grid to blanks
For TextBoxIndex = 1 To 42
' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
strNum = Right("00" & TextBoxIndex, 2)
Set ctlCalendar = Me("CalDay" & strNum) ' Note: similar to Me.Caldayxx, but allows a string
ctlCalendar.Value = ""
ctlCalendar.BackColor = constBackground
Next
Set ctlCalendar = Nothing
End Sub
Private Sub NumberCalendar()
Dim FirstDay As Integer
Dim DayIndex As Integer
Dim TextBoxIndex As Integer
Dim Done As Boolean
Dim ctlCalendar As Control
Dim strNum As String
FirstDay = Weekday(Me.txtCalendarHeading) ' Figure out the first day of the week
DayIndex = 1 ' Start counting days at 1
TextBoxIndex = FirstDay ' Start indexing text boxes at first day in month
Done = False
While Not (Done)
' Set the value of the correct CalDayxx text box
' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
strNum = Right("00" & TextBoxIndex, 2)
Set ctlCalendar = Me("CalDay" & strNum) ' Note: similar to Me.Caldayxx, but allows a string
ctlCalendar.Value = DayIndex
ctlCalendar.BackColor = constUnshaded
DayIndex = DayIndex + 1
TextBoxIndex = TextBoxIndex + 1
' Are we done? Check to see if we have indexed into next month
If (Month(Me.txtCalendarHeading + (DayIndex - 1)) <> Month(Me.txtCalendarHeading)) Then
Done = True
End If
Wend
Set ctlCalendar = Nothing
End Sub
我如何将复选框值传递给字符串或表格进行打印?
答案 0 :(得分:0)
尝试在“打印”按钮中使用以下代码。它将创建一个包含所有日期的字符串。
Dim strNum As Integer
Dim strPicked As String
Dim ctl As Control
strPicked = ""
For strNum = 1 To 42
Set ctl = Me("CalDay" & right("00" & strNum, 2))
If ctl.BackColor = constShaded Then
strPicked = strPicked & ctl & "; "
End If
Next strNum
MsgBox "You selected: " & strPicked