Создание ежемесячного календаря в каждой электронной таблице

Question

Теперь мне, наконец, удалось собрать весь код, и теперь все выглядит правильно и не дает никакой синтаксической ошибки. Однако после завершения кода программа ничего не делает.

У меня есть приложение в VBA, которое запрашивает дату начала (месяц) и дату окончания, а затем выводит ежемесячный календарь с каждым месяцем в каждой электронной таблице.

Например: если пользователь выбирает сентябрь (8) в качестве даты начала и декабрь в качестве даты окончания (11), он должен выводить все месяцы между сентябрем и декабрем в каждой электронной таблице.

Вот код для этого

Private Sub UserForm_Initialize() 
    start_date.AddItem ("January"), 0 
    start_date.AddItem ("February"), 1 
    start_date.AddItem ("March"), 2 
    start_date.AddItem ("April"), 3 
    start_date.AddItem ("May"), 4 
    start_date.AddItem ("June"), 5 
    start_date.AddItem ("July"), 6 
    start_date.AddItem ("August"), 7 
    start_date.AddItem ("September"), 8 
    start_date.AddItem ("October"), 9 
    start_date.AddItem ("November"), 10 
    start_date.AddItem ("December"), 11 


    end_date.AddItem ("January"), 0 
    end_date.AddItem ("February"), 1 
    end_date.AddItem ("March"), 2 
    end_date.AddItem ("April"), 3 
    end_date.AddItem ("May"), 4 
    end_date.AddItem ("June"), 5 
    end_date.AddItem ("July"), 6 
    end_date.AddItem ("August"), 7 
    end_date.AddItem ("September"), 8 
    end_date.AddItem ("October"), 9 
    end_date.AddItem ("November"), 10 
    end_date.AddItem ("December"), 11 

End Sub 


Private Sub newProjectNext1_Click() 
    Dim strArrayOne(11) As String 
    Dim wsArrayOne(11) As Worksheet 

    strArrayOne(0) = "January" 
    strArrayOne(1) = "February" 
    strArrayOne(2) = "March" 
    strArrayOne(3) = "April" 
    strArrayOne(4) = "May" 
    strArrayOne(5) = "June" 
    strArrayOne(6) = "July" 
    strArrayOne(7) = "August" 
    strArrayOne(8) = "September" 
    strArrayOne(9) = "October" 
    strArrayOne(10) = "November" 
    strArrayOne(11) = "December" 

    Dim ArrayTwo(11) As String 
    ArrayTwo(0) = "January 2015" 
    ArrayTwo(1) = "February 2015" 
    ArrayTwo(2) = "March 2015" 
    ArrayTwo(3) = "April 2015" 
    ArrayTwo(4) = "May 2015" 
    ArrayTwo(5) = "June 2015" 
    ArrayTwo(6) = "July 2015" 
    ArrayTwo(7) = "August 2015" 
    ArrayTwo(8) = "September 2015" 
    ArrayTwo(9) = "October 2015" 
    ArrayTwo(10) = "November 2015" 
    ArrayTwo(11) = "December 2015" 

    Do Until start_date.ListIndex <= end_date.ListIndex 
     Set wsArrayOne(start_date.ListIndex) = Sheets.Add 
     Sheets.Add.Name = strArrayOne(start_date.ListIndex) 
     Application.ScreenUpdating = False 
     Range("a1:g14").Clear 
     MyInput = ArrayTwo(start_date.ListIndex) 
     If MyInput = "" Then Exit Sub 
     StartDay = DateValue(MyInput) 
     If Day(StartDay) <> 1 Then 
      StartDay = DateValue(Month(StartDay) & "/1/" & _ 
           Year(StartDay)) 
     End If 
     Range("a1").NumberFormat = ArrayTwo(start_date.ListIndex) 
     With Range("a1:g1") 
      .HorizontalAlignment = xlCenterAcrossSelection 
      .VerticalAlignment = xlCenter 
      .Font.Size = 18 
      .Font.Bold = True 
      .RowHeight = 35 
     End With 
     With Range("a2:g2") 
      .ColumnWidth = 11 
      .VerticalAlignment = xlCenter 
      .HorizontalAlignment = xlCenter 
      .VerticalAlignment = xlCenter 
      .Orientation = xlHorizontal 
      .Font.Size = 12 
      .Font.Bold = True 
      .RowHeight = 20 
     End With 
     Range("a2") = "Sunday" 
     Range("b2") = "Monday" 
     Range("c2") = "Tuesday" 
     Range("d2") = "Wednesday" 
     Range("e2") = "Thursday" 
     Range("f2") = "Friday" 
     Range("g2") = "Saturday" 
     With Range("a3:g8") 
      .HorizontalAlignment = xlRight 
      .VerticalAlignment = xlTop 
      .Font.Size = 18 
      .Font.Bold = True 
      .RowHeight = 21 
     End With 
     Range("a1").Value = Application.Text(MyInput, "mmmm yyyy") 
     DayofWeek = Weekday(StartDay) 
     CurYear = Year(StartDay) 
     CurMonth = Month(StartDay) 
     FinalDay = DateSerial(CurYear, CurMonth + 1, 1) 
     Select Case DayofWeek 
     Case 1 
      Range("a3").Value = 1 
     Case 2 
      Range("b3").Value = 1 
     Case 3 
      Range("c3").Value = 1 
     Case 4 
      Range("d3").Value = 1 
     Case 5 
      Range("e3").Value = 1 
     Case 6 
      Range("f3").Value = 1 
     Case 7 
      Range("g3").Value = 1 
     End Select 
     For Each cell In Range("a3:g8") 
      RowCell = cell.Row 
      ColCell = cell.Column 
      If cell.Column = 1 And cell.Row = 3 Then 
      ElseIf cell.Column <> 1 Then 
       If cell.Offset(0, -1).Value >= 1 Then 
        cell.Value = cell.Offset(0, -1).Value + 1 
        If cell.Value > (FinalDay - StartDay) Then 
         cell.Value = "" 
         Exit For 
        End If 
       End If 
      ElseIf cell.Row > 3 And cell.Column = 1 Then 
       cell.Value = cell.Offset(-1, 6).Value + 1 
       If cell.Value > (FinalDay - StartDay) Then 
        cell.Value = "" 
        Exit For 
       End If 
      End If 
     Next 
     For x = 0 To 5 
      Range("A4").Offset(x * 2, 0).EntireRow.Insert 
      With Range("A4:G4").Offset(x * 2, 0) 
       .RowHeight = 65 
       .HorizontalAlignment = xlCenter 
       .VerticalAlignment = xlTop 
       .WrapText = True 
       .Font.Size = 10 
       .Font.Bold = False 
       .Locked = False 
      End With 
      With Range("A3").Offset(x * 2, 0).Resize(2, _ 
                7).Borders(xlLeft) 
       .Weight = xlThick 
       .ColorIndex = xlAutomatic 
      End With 
      With Range("A3").Offset(x * 2, 0).Resize(2, _ 
                7).Borders(xlRight) 
       .Weight = xlThick 
       .ColorIndex = xlAutomatic 
      End With 
      Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _ 
        Weight:=xlThick, ColorIndex:=xlAutomatic 
     Next 
     If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _ 
      .Resize(2, 8).EntireRow.Delete 
     ActiveWindow.DisplayGridlines = False 
     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _ 
          Scenarios:=True 
     ActiveWindow.WindowState = xlMaximized 
     ActiveWindow.ScrollRow = 1 
     Application.ScreenUpdating = True 
     Exit Sub 

     start_date.ListIndex = start_date.ListIndex + 1 
    Loop 

End Sub 

Я попытался проверить, если номера для выхода start_date.ListIndex и end_date.ListIndex правильных значения, выбранных из выпадающего списка, и они работали хорошо.

Он ничего не выводит, даже ошибки.

Answer 1

Несколько вещей, чтобы рассмотреть следующие вопросы:

1-Эта линия останавливает выполнение от идти. Если дата начала меньше даты окончания, это условие истинно и никогда не войдет в цикл.

Do Until start_date.ListIndex <= end_date.ListIndex 

Я думаю, вы должны использовать do..while вместо

Do While start_date.ListIndex <= end_date.ListIndex 

2-Эта линия дает ошибку, я думаю, что вы хотите установить значение, а не NumberFormat

Range("a1").NumberFormat = ArrayTwo(start_date.ListIndex) 

3-Эта линия выходит из вашей петли после одной итерации, прокомментируйте это

Exit Sub 

4-Вы добавляете два листа каждый раз с этими линиями, так как вы не используете этот лист в качестве эталона (который вы должны), вы можете закомментировать первую строку

Set wsArrayOne(start_date.ListIndex) = Sheets.Add 
Sheets.Add.Name = strArrayOne(start_date.ListIndex) 

лучшим способом было бы объявить переменную рабочего листа, а затем использовать ее в качестве ссылки во всех случаях (если вы не привязываете вызовы манипуляции с ячейкой к листу, они будут выполняться на любом активном листе в это время, что в этом случае в порядке, но позже вы столкнетесь с проблемой, если работаете одновременно с несколькими листами. Это было бы лучше

Dim ws as worksheet 
Set ws=Sheets.Add 
ws.name=strArrayOne(start_date.ListIndex) 
'then bind your cell manuipulations to the worksheet variable like this 

ws.Range("a1:g14").Clear 

Других вещей, чтобы рассмотреть, когда пользователь делает неожиданным, как кирки мая в February..the цикла не будет работать, но вы могли бы дать пользователю сообщение о том, дате начала должна быть меньше, чем дата окончания. Кроме того, привыкнуть добавлять обработку ошибок к вашему коду, если кодирование становится больше, чем школьный проект, тогда обработка ошибок имеет важное значение и лучше всего забрать его раньше! Удачи!