2014-09-19 25 views
0

我有一個帶有日曆的窗體,我想選擇日曆中的日期並單擊打印按鈕,結果是在日曆中選擇的日期列表中打印。訪問傳遞複選框值爲要打印的字符串

實施例:

Calendar

我選擇天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

您的問題是? – RossC 2014-09-19 07:50:12

+0

對不起,我選中複選框的值爲字符串或表格......要打印... – SaPires 2014-09-19 07:52:16

+0

您使用的是哪個版本的Access? – 2014-09-19 13:09:51

回答

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 
+0

這幫助了很多,但我需要把在一個報告中的信息是這樣的:'2014年9月1日 2014年9月2日 16 2014年9月 9月17日2014' – SaPires 2014-09-19 13:55:34

+0

你原來的問題是「我如何將複選框的值傳遞給一個字符串或表來打印?「 - 我提供瞭如何獲得一個字符串。你知道如何創建一個表並填充VBA嗎?如果是這樣,我建議你手動創建表格,然後在循環之前清除表格,然後在每個選定日期的循環.AddNew中。您知道標題中的月份/年份,因此只需創建每天的日期。 – 2014-09-19 13:59:37