Results 1 to 7 of 7

Thread: [RESOLVED] 2 Combo Boxes

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2010
    Posts
    445

    Resolved [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?

  2. #2
    Frenzied Member
    Join Date
    May 2006
    Location
    some place in the cloud
    Posts
    1,886

    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

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2010
    Posts
    445

    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?

  4. #4
    Fanatic Member
    Join Date
    Mar 2009
    Posts
    804

    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

  5. #5

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2010
    Posts
    445

    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

  6. #6
    Frenzied Member
    Join Date
    May 2006
    Location
    some place in the cloud
    Posts
    1,886

    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

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2010
    Posts
    445

    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
  •  



Click Here to Expand Forum to Full Width