Excel VBA質問箱 IV

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

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


39072 / 76732 ←次へ | 前へ→

【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
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 発言

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