|
-
May 16th, 2011, 10:35 AM
#1
Thread Starter
Hyperactive Member
[RESOLVED] 2 Combo Boxes
Hi
http://www.vbforums.com/images/smilies/wave.gif
Frame A has a Combo Box for Week Nos.
Frame B has a Combo Box for Week Nos.
Both Frames are on the same Form.
Private Sub myWeekNums
If FrameA.Visible = True Then
With cboF_A
AddItem "Wk1"
AddItem "Wk2"
AddItem "Wk3" up to 52
End With
ElseIf FrameB.Visible = True Then
With cboF_B
AddItem "Wk1"
AddItem "Wk2"
AddItem "Wk3" up to 52
End With
End If
End Sub
What I would like to do is have one Combo Box loading to serve both frames.
It is possible for both frames to be visible at the same time.
Can you help please?
-
May 16th, 2011, 10:28 PM
#2
Re: 2 Combo Boxes
Code:
Dim I As Integer
For I = 1 To 52
cboF_A AddItem "Wk" & Format(I)
cboF_B AddItem "Wk" & Format(I)
Next I
and, yes, both combos can be visible at the same time, in the same or different frames
JG
-
May 17th, 2011, 02:33 AM
#3
Thread Starter
Hyperactive Member
Re: 2 Combo Boxes
Hi JG
I must apologize I committed the cardinal sin typing in the code instead of copying which means you did not see the full picture.
This is the code for the combo box
.AddItem "Jan 4th = Wk.1", 1
.AddItem "Jan 11th = Wk.2", 2
.AddItem "Jan 18th = Wk.3", 3
Can there be a solution? or am I stuck with typing 2 full lists?
-
May 17th, 2011, 08:00 AM
#4
Re: 2 Combo Boxes
If I understand, you need a function to return the
Week Number, given a date. Try this code:
Code:
Public Function WeekNumber(InDate As Date) As Long
Dim DayNo As Long
Dim StartDays As Long
Dim StopDays As Long
Dim StartDay As Long
Dim StopDay As Long
Dim VNumber As Long
Dim ThurFlag As Boolean
DayNo = Days(InDate)
StartDay = Weekday(DateSerial(Year(InDate), 1, 1)) - 1
StopDay = Weekday(DateSerial(Year(InDate), 12, 31)) - 1
' Number of days belonging to first calendar week
StartDays = 7 - (StartDay - 1)
' Number of days belonging to last calendar week
StopDays = 7 - (StopDay - 1)
' Test to see if the year will have 53 weeks or not
ThurFlag = (StartDay = 4) Or (StopDay = 4)
VNumber = (DayNo - StartDays - 4) / 7
' If first week has 4 or more days, it will be calendar week 1
' If first week has less than 4 days, it will belong to last year's
' last calendar week
If StartDays >= 4 Then
WeekNumber = Fix(VNumber) + 2
Else
WeekNumber = Fix(VNumber) + 1
End If
' Handle years whose last days will belong to coming year's first
' calendar week
If WeekNumber > 52 And ThurFlag = False Then WeekNumber = 1
' Handle years whose first days will belong to the last year's
' last calendar week
If WeekNumber = 0 Then
WeekNumber = WeekNumber(DateSerial(Year(InDate) - 1, 12, 31))
End If
End Function
Private Function Days(DayNo As Date) As Long
Days = DayNo - DateSerial(Year(DayNo), 1, 0)
End Function
Function DaysInMonth(YearValue As Long, MonthValue As Long) As Long
DaysInMonth = Day(DateSerial(YearValue, MonthValue + 1, 0))
End Function
'sample useage
Private Sub Form_Load()
Dim i As Long
Dim d As Date
For i = 1 To 31
d = DateSerial(2011, 5, i)
Debug.Print d, WeekNumber(d)
Next
End Sub
-
May 17th, 2011, 09:42 AM
#5
Thread Starter
Hyperactive Member
Re: 2 Combo Boxes
Hi VBClasicRocks
That is some stunning code thanks, I will now have to work out how to use it.
It would be a shame not too after I saw the result from the test.
Regards
-
May 17th, 2011, 12:10 PM
#6
Re: 2 Combo Boxes
Code:
Private Sub Form_Load()
'To call the procedure that fills the comboboxes
Dim MyF As Date
MyF = CDate("04/01/2011")
FillCombos MyF
End Sub
Sub FillCombos(FirstDayOfWeek As Date)
'Fill comboboxes
Dim I As Integer
For I = 1 To 52
cboF_A.AddItem Format(FirstDayOfWeek, "mmm") & " " & Format(FirstDayOfWeek, "dd") & " Wk." & Format(Week(FirstDayOfWeek), "00")
cboF_B.AddItem Format(FirstDayOfWeek, "mmm") & " " & Format(FirstDayOfWeek, "dd") & " Wk." & Format(Week(FirstDayOfWeek), "00")
FirstDayOfWeek = FirstDayOfWeek + 7
Next I
End Sub
Private Function Week(dteValue As Date) As Integer
'Calculate week number
'Monday is set as first day of week
Dim lngDate As Long
Dim intWeek As Integer
'If january 1. is later than thursday, january 1. is not in week 1
If Not Weekday("01/01/" & Year(dteValue), vbMonday) > 4 Then
intWeek = 1
Else
intWeek = 0
End If
'Sets long-value for january 1.
lngDate = CLng(CDate("01/01/" & Year(dteValue)))
'Finds the first monday of year
lngDate = lngDate + (8 - Weekday("01/01/" & Year(dteValue), vbMonday))
'Increases week by week until set date is passed
While Not lngDate > CLng(CDate(dteValue))
intWeek = intWeek + 1
lngDate = lngDate + 7
Wend
'If the date set is not in week 1, this finds latest week previous year
If intWeek = 0 Then
intWeek = Week("31/12/" & Year(dteValue) - 1)
End If
Week = intWeek
End Function
JG
-
May 18th, 2011, 02:58 AM
#7
Thread Starter
Hyperactive Member
Re: 2 Combo Boxes
Hi JG
Stunning and totally brilliant solves the problem completely, I also hope to learn from the construction you have used.
Many thanks again.
Regards
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|