Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


39083 / 76738 ←次へ | 前へ→

【42776】Re:週単位で1枚の依頼書をプリントアウ...
発言  飛ばない豚  - 06/9/21(木) 15:31 -

引用なし
パスワード
   ▼ゆき さん:
想像の部分もありますが、コードを作ってみました。


まず、祭日(振替休日)のデータを用意します。

サンプルの場合、Worksheets("seet3").Range("F16:F31")にしました。
(適宜変更してください)
年間20日ぐらいあれば足りるとおもいますが、
多めに用意して、空白にしても構いません。

データは数値です。
1月 1日: 101
9月18日: 918
11月23日:1123
というようにして下さい。

また、月初の1週間休日は想定してません。
5月などに連休が続く場合は、日曜日も祭日として設定しておいて下さい。

年度は設定してません。「今年」を取得します。
1月分を作成する場合のみ、「来年」を取得します。
祭日データもそのつもりで設定してください。


下のコードを実行すると、変数myPrtDT()に週の開始日と終了日
(祭日をはさむ場合は、その分追加)が格納されます。

コードの最後の方でDebug.Printするようにしてます。


開始日myPrtDT(0,myLooP)、終了日myPrtDT(0,myLooP)を
適宜セルにセットして、印刷を行うと良いです。


開始日については、月初めは、第1月曜の週から始め、
終了日は、最終月曜日の週末(金曜日)まで格納するようにしてます。

例えば、2006年11月の場合、
0      開始日: 6   終了日: 10
1      開始日: 13  終了日: 17
2      開始日: 20  終了日: 22
3      開始日: 24  終了日: 24
4      開始日: 27  終了日: 31
と格納されます。
最終日は、DateSerial(2006,11,31)で2006/12/01が算出できますので、
加工して下さい。


Private Sub sub_印刷サンプル()
  Dim myYear   As Long     '年
  Dim myMonth   As Long     '月
  Dim myDayS   As Long     '印刷開始日
  Dim myDayE   As Long     '印刷終了日
  Dim myDate   As Date     '
  Dim myRange   As Range    '祭日、振替休日データ取得用
  Dim myHoliday  As Object    '祭日、振替休日データ格納
  Dim myLooP   As Long     '
  Dim myPrtDT()  As Long     '開始日と終了日を格納
  Dim myBoolW   As Boolean   '
  Dim myBoolH   As Boolean   '
  
  myMonth = 11    '11月の場合(適宜セット)
  myYear = Year(Date)
  
  '1月分作成の場合は翌年分(不要なら削除)
  If myMonth = 1 Then myYear = myYear + 1
  
  '祭日データの取得(予め準備しておくこと)
  Set myHoliday = CreateObject("Scripting.Dictionary")
  For Each myRange In Worksheets("seet3").Range("F16:F31")
    myHoliday(myRange.Value) = True
  Next
  
  '最初の月曜日を算出(休日の場合は翌日)
  myDayS = 8 - Weekday(DateSerial(myYear, myMonth, 1), 3)
  Do While myHoliday(myMonth * 100 + myDayS)
    myDayS = myDayS + 1
  Loop
  
  '最終日を算出(翌月の場合、31以上になる)
  myDate = DateSerial(myYear, myMonth + 1, 1)
  myDayE = Day(DateAdd("d", -Weekday(myDate, 3), myDate)) + 4
  
  'データの格納
  ReDim myPrtDT(1, 0)
  myPrtDT(0, 0) = myDayS
  myPrtDT(1, 0) = myDayS
  myBoolW = True
  For myLooP = myDayS To myDayE
    myDate = DateSerial(myYear, myMonth, myLooP)
    myBoolH = Not (Weekday(myDate) = 1 Or Weekday(myDate) = 7 Or _
            myHoliday(CLng(Format(myDate, "mmdd"))))
    
    If myBoolW = myBoolH Then
      If myBoolW Then
        myPrtDT(1, UBound(myPrtDT, 2)) = myLooP
      End If
    Else
      If Not myBoolW Then
        ReDim Preserve myPrtDT(1, UBound(myPrtDT, 2) + 1)
        myPrtDT(0, UBound(myPrtDT, 2)) = myLooP
        myPrtDT(1, UBound(myPrtDT, 2)) = myLooP
      End If
      myBoolW = myBoolH
    End If
    
  Next myLooP
  
  '印刷処理
  For myLooP = LBound(myPrtDT, 2) To UBound(myPrtDT, 2)
    Debug.Print myLooP, "開始日:"; myPrtDT(0, myLooP), _
              "終了日:"; myPrtDT(1, myLooP)
    
    '開始日と終了日をセットして印刷する。
    '月末は31を越える場合があるので注意
    
  Next myLooP
  
  Set myHoliday = Nothing
End Sub


それでは。(^・ω・^)
0 hits

【42768】週単位で1枚の依頼書をプリントアウトしたい ゆき 06/9/21(木) 11:33 質問
【42774】Re:週単位で1枚の依頼書をプリントアウト... ハチ 06/9/21(木) 14:39 発言
【42781】Re:週単位で1枚の依頼書をプリントアウト... ハチ 06/9/21(木) 17:40 発言
【42798】Re:週単位で1枚の依頼書をプリントアウト... かみちゃん 06/9/22(金) 1:49 発言
【42776】Re:週単位で1枚の依頼書をプリントアウ... 飛ばない豚 06/9/21(木) 15:31 発言

39083 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free