Excel VBA質問箱 IV

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

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


6844 / 13646 ツリー ←次へ | 前へ→

【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 発言[未読]

【42768】週単位で1枚の依頼書をプリントアウトし...
質問  ゆき  - 06/9/21(木) 11:33 -

引用なし
パスワード
   お世話になります。
初心者です。よろしくお願い申し上げます。

さて、さっそくですが質問です。
毎月、月末に翌月1か月分の空調の時間延長依頼を提出しています。
依頼書は、週単位(平日のみ月曜〜金曜)で提出しますので、
月5週だと、5枚となります。
しかし、例えば、水曜日に祝日が入るとすると、
月曜〜火曜の依頼書1枚と、木曜〜金曜の依頼書2枚に分かれます。

祝日が無い月のコードは私なりに作ってみたのですが・・・

出来れば月を指定すると、依頼書がプリントアウトされるようにしたいと思うのですが
どのようにコードを書けばいいかわかりませ。
よろしくお願い申し上げます。

【42774】Re:週単位で1枚の依頼書をプリントアウ...
発言  ハチ  - 06/9/21(木) 14:39 -

引用なし
パスワード
   ▼ゆき さん:
>お世話になります。
>初心者です。よろしくお願い申し上げます。
>
>さて、さっそくですが質問です。
>毎月、月末に翌月1か月分の空調の時間延長依頼を提出しています。
>依頼書は、週単位(平日のみ月曜〜金曜)で提出しますので、
>月5週だと、5枚となります。
>しかし、例えば、水曜日に祝日が入るとすると、
>月曜〜火曜の依頼書1枚と、木曜〜金曜の依頼書2枚に分かれます。
>
>祝日が無い月のコードは私なりに作ってみたのですが・・・

このコードをUPされてみてはどうですか?
この内容ではまったくわかりません。

ちなみに祝日を判定する関数はありませんので、
どなたか作られたアドインOr関数を使わせてもらうのが良いと思います。

【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


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

【42781】Re:週単位で1枚の依頼書をプリントアウ...
発言  ハチ  - 06/9/21(木) 17:40 -

引用なし
パスワード
    http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_050.html
こちらの井上さんの作成された
(いつも活用させて頂いてます。井上さんありがとうございます!)
関数"CHECKEIGYOBI"を使用させて頂いて
こんな感じでも必要な日付を取得できそうです。
時間があるときにでも試してみてください。

Option Explicit

Sub Test()

Dim Ans As String
Dim Datebuf As Date, StDay As Date, EnDay As Date
Dim Fg As Boolean
Dim Ran As Range
Dim i As Long

  Ans = InputBox("作成する月を指定(yyyy/mm)")
  If Ans Like "####/##" = False Then
    MsgBox "yyyy/mmで指定してください": Exit Sub
  End If
  Cells.ClearContents
  Set Ran = Range("A1:B1")
  Ran = Array("開始日", "終了日")
  i = 1: Fg = False
  Datebuf = DateValue(Ans & "/01")
  Do While Format(Datebuf, "yyyy/mm") Like Ans = True
    If CHECKEIGYOBI(Datebuf) = 1 Then
      If Fg = False Then
        StDay = Datebuf: Fg = True
      End If
      EnDay = Datebuf
    Else
      If Fg = True Then
        Ran.Offset(i) = Array(StDay, EnDay)
        i = i + 1: Fg = False
      End If
    End If
    Datebuf = Datebuf + 1
  Loop
  '最終週用
  If Fg = True Then
    Ran.Offset(i) = Array(StDay, EnDay)
  End If
End Sub

【42798】Re:週単位で1枚の依頼書をプリントアウ...
発言  かみちゃん E-MAIL  - 06/9/22(金) 1:49 -

引用なし
パスワード
   こんにちは。かみちゃん です。

横から失礼します。

>ちなみに祝日を判定する関数はありませんので、

私は、祝日を判定するために、以下のURLで紹介されている
ktHolidayNameを使っています。
http://www.h3.dion.ne.jp/~sakatsu/holiday_logic.htm

MsgBox ktHolidayName("2006/9/18")
とすると「敬老の日」と表示されると思います。

空調の時間延長依頼ですか・・・私の会社でもExcelで出しているようです。

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