MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Access Passar valor de check box para imprimir

    Compartilhe

    SaPires
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5
    Registrado : 22/04/2014

    Access Passar valor de check box para imprimir

    Mensagem  SaPires em Sex 19 Set 2014, 10:14

    Tenho uma form com um calendario e quero selecionar os dias no calendário e quando carregar em print o resultado seja uma lista dos dias escolhidos.

    Exemplo:[Você precisa estar registrado e conectado para ver esta imagem.]



    Eu selecionei os dias 1, 2, 16 e 17 ou seja o resultado da impressão seria:

    1 September 2014

    2 September 2014

    16 September 2014

    17 September 2014

    Este é o codigo vba:

       
    Código:
    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

    Preciso saber como passo os valores selecionados para ser possivel imprimir.

    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 2746
    Registrado : 06/11/2009

    Re: Access Passar valor de check box para imprimir

    Mensagem  Assis em Sex 19 Set 2014, 17:38

    Boa tarde
    SaPires
    E no calendário consegue selecionar mais que um dia ?
    Se sim .... pode postar só o formulario do calendário ?

    Ou parte da BD caso ainda não tenha resolvido o seu problema.

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***

      Data/hora atual: Ter 06 Dez 2016, 05:44