Excel VBA - удалить выходные из автоматической печати расписания - PullRequest
Новая
       20

Excel VBA - удалить выходные из автоматической печати расписания

0 голосов
/ 12 марта 2019

Я немного изменил код, который нашел в Интернете.

Цель:

Нажмите кнопку «Печать с датами», затем введите дату начала, и Excel автоматически создаст / напечатает месяцыстоимость расписаний (намного лучше, чем в предыдущей таблице, в которой было напечатано 6 недель страниц, и вам приходилось редактировать каждую дату вручную).

Проблемы:

  • Он печатаетвыходные, которые тратят бумагу.Есть ли способ, которым он может ссылаться на список дат (выходные, праздничные дни), а не генерировать их для печати?

  • Вы увидите формат даты m / d /гггг в коде, который странным образом печатается как дд / мм / гггг (что я и хотел).Когда код был дд / мм / гггг, он печатался правильно (20/03/2019), но если перейти к следующему месяцу, он переключался на американский формат м / д / гггг (20/04/2019).Я знаю, что это, кажется, не имеет смысла, но наличие его как m / d / yyyy на самом деле печатает как dd / mm / yyyy для любых дат начала / окончания.Я хотел бы знать, почему, а также иметь код dd / mm / yyyy в коде, корректно печатающем в любом диапазоне дат.

КОД: 

Sub PrintSheet()
    Dim s As String
    Dim d As Date
    s = InputBox(Prompt:="Please enter the start date")
    If Not IsDate(s) Then
        MsgBox "Incorrect date", vbExclamation
        Exit Sub
    End If
    For d = CDate(s) To DateAdd("m", 1, CDate(s)) - 1
        Range("F2").Value = Format(d, "dddd")
        Range("I2").Value = "" & Format(d, "m/d/yyyy")
        ActiveSheet.PrintOut
    Next d
End Sub

Заранее спасибо:)

1 Ответ

0 голосов
/ 12 марта 2019

Вы можете использовать функцию дня недели. Возвращает число от 1 до 7. Вы можете фильтровать 1-5 только по рабочим дням. 

Sub PrintSheet()
    Dim s As String
    Dim d As Date
    s = InputBox(Prompt:="Please enter the start date")
    If Not IsDate(s) Then
        MsgBox "Incorrect date", vbExclamation
        Exit Sub
    End If
    For d = CDate(s) To DateAdd("m", 1, CDate(s)) - 1
        If Weekday(d, vbMonday) < 6 Then
        Range("F2").Value = Format(d, "dddd")
        Range("I2").Value = "" & Format(d, "m/d/yyyy")
        'MsgBox ("printing ") 'for testing
        ActiveSheet.PrintOut
        End If
    Next d
End Sub
...