INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Calendars

Calendar using dynamic form by gol4
Posted: 17 Dec 03

This is a real ugly example of a calendar using a dynamic form. It is intended to show how to create a form then add controls to that form then lastly add code to the forms module.
the code appears this ugly to conserve posting space

paste the following code in a module then call using getdate.
Example from debug window

?getdate

the calendar will pop up click on the desired date it will return it as a string.
Good luck
'Start  of Code
'--------------------------------------------

Public Function Getdate() As Variant
' edit to get what ever return you want
Dim stFRmName As String
stFRmName = CreateCalForm
Do Until IsDate(Forms(stFRmName).Tag) ' check to see if date selected
DoEvents
Loop
Getdate = Forms(stFRmName).Tag
DoCmd.CLOSE acForm, stFRmName, acSaveNo
End Function
Public Function CreateCalForm() As String
Dim frm As Form
'creates form
Set frm = CreateForm
With frm 'set any additional form properties you need here
.Caption = "POP UP Calender"
.RecordSelectors = False
.NavigationButtons = False
.Width = 2.5
.Section(acDetail).Height = 3
CreateCalForm = .name
End With
Call LoadControls(frm)
End Function

Public Function LoadControls(ByVal frm As Form)
Dim txt(42) As Control, ctlMonth As Control
Dim ctlYear As Control
Dim txtLeft As Integer, TxtTop As Integer
Dim xPos As Integer, yPos As Integer, X As Integer
Dim TxtHeight As Integer, TxtWidth As Integer
Dim stFRmNam As String
stFRmNam = frm.name
'Adjust to size boxes. Could base on size of form
TxtHeight = 400
TxtWidth = 400
TxtTop = 400
txtLeft = 5
'creates 6x7 grid of text boxes
For yPos = 1 To 6
For xPos = 1 To 7
Set txt(X) = CreateControl(stFRmNam, acTextBox, , "", "", txtLeft, TxtTop, TxtWidth, TxtHeight)
txtLeft = txtLeft + TxtWidth 'sets with of text boxes
'set any additional properties or events here
txt(X).OnClick = "=Clicked()" 'add on click event to each box
txt(X).name = "d" & X + 1 'name boxes like an array
X = X + 1
Next xPos 'next box
txtLeft = 5 'go back to left start position
TxtTop = TxtTop + TxtHeight 'drop down height
Next yPos  'next row
'create additional txtboxes to hold Month & year
Set ctlMonth = CreateControl(stFRmNam, acTextBox, , "", "", 100, 10, 1000, 300)
ctlMonth.name = "txMonth"
Set ctlYear = CreateControl(stFRmNam, acTextBox, , "", "", 1100, 10, 1000, 300)
ctlYear.name = "txYear"
' load module to load dates and open form
Call LoadModule(frm)
DoCmd.OpenForm stFRmNam
End Function
Public Function LoadModule(ByVal frm As Form)
 Dim Mdl As Module
 Dim stBld As String
'creates module
Set Mdl = frm.Module
'creates eventprocedures This is ugly to save space. You can see it better
'Once form is created click on design view
stBld = stBld & "Private Function LoadCal(dtMonth as integer, dtyear as integer)" & vbCrLf
stBld = stBld & "Dim Curday as Variant, dtFirst as variant" & vbCrLf
stBld = stBld & "curday = DateSerial(dtyear, dtmonth, 1)" & vbCrLf
stBld = stBld & "dtFirst = curday" & vbCrLf
stBld = stBld & "me![txMonth] = Format(dtFirst, ""m"")" & vbCrLf
stBld = stBld & "me![txYear] = Format(dtFirst, ""YYYY"")" & vbCrLf
stBld = stBld & "Do Until curday = DateSerial(dtyear, dtmonth + 1, 1)" & vbCrLf
stBld = stBld & "me(""D"" & Day(curday) + WeekDay(dtFirst) - 1) = Day(curday)" & vbCrLf
stBld = stBld & vbCrLf & "curday = DateAdd(""d"", 1, curday)" & vbCrLf & "Loop" & vbCrLf
stBld = stBld & "End Function" & vbCrLf
stBld = stBld & "Private Sub Form_Load()" & vbCrLf
stBld = stBld & "DoCmd.RunCommand (acCmdSizeToFitForm)" & vbCrLf
stBld = stBld & "Call LoadCal(Month(date),Year(date))" & vbCrLf & " End Sub" & vbCrLf
stBld = stBld & "Public Function Clicked()" & vbCrLf
stBld = stBld & "me.tag = txmonth & ""/"" & me.activecontrol.value & ""/"" & txYear" & vbCrLf & "End Function"
stBld = stBld & vbCrLf & "Private Sub txMonth_AfterUpdate()" & vbCrLf
stBld = stBld & "call ClearCal()" & vbCrLf & "call LoadCal(me!txmonth, me!txYear)" & vbCrLf
stBld = stBld & "End Sub" & vbCrLf
stBld = stBld & "Private Sub txYear_AfterUpdate()" & vbCrLf
stBld = stBld & "call ClearCal()" & vbCrLf & "call LoadCal(me!txmonth, me!txYear)" & vbCrLf
stBld = stBld & "End Sub" & vbCrLf
stBld = stBld & "Private Sub ClearCal()" & vbCrLf
stBld = stBld & "Dim X as integer" & vbCrLf & "for x = 1 to 42" & vbCrLf
stBld = stBld & "me(""D"" & x) = """ & vbCrLf
stBld = stBld & "next x" & vbCrLf & "End Sub"
'can also use ( insertlines addfromfile addfromstring) in place of inserttext
Mdl.InsertText stBld
End Function


Back to Microsoft: Access Forms FAQ Index
Back to Microsoft: Access Forms Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close