Posted in work

【Excel】 年間スケジュール自動作成マクロ

2010年12月9日 - 10:30 PM




エクセルのマクロを勉強していて、
最近使えそうなマクロを書いたので
プログラムを公開してみようと思います。
※マクロについての細かい説明は割愛。


今回作ったのは、
年間スケジュールを自動作成するマクロ。

ボタン1つで1年分のスケジュールを
作ることができます。


主な仕様、機能としては、

・「スケジュール表を作成」ボタンを押すと
 1年分のスケジュール表が自動作成される。
 ※ベースのテンプレートシートをどんどん複製していき、
  日付を入力、土日祝日により文字色を変えたり、
  セルを塗りつぶしていくイメージ。

・「スケジュール表を削除」ボタンを押すと作成した表を全て削除。 
 (気に入らなかったら何度でもやり直し)


1年分のスケジュールができるので、
1度作ってしまえばあとは必要な月を切り取って使えばOK。

プログラムを少しいじれば年が変わっても使えます。

 
キャプチャで簡単にご紹介。

IMG_7146
こちらがテンプレート。
コレをどんどん複製していきます。


IMG_7146
こちらのシートでは日付や祝日を管理。
作成ボタン、削除ボタンもこのシートに置いてあります。


IMG_7146
どんどん複製している様子1。
日付が入り、土日祝日はグレーで塗りつぶされます。


IMG_7146
どんどん複製している様子1。
土曜は青字、日曜は赤字に文字色が変わります。
平日かそうでないか一目瞭然。



静止画キャプチャでは全然伝わらないので
動画キャプチャを撮ってみました。
(最初からそうしろ)





画質は汚いですが、
なんとなく動作が分かっていただけたかと思います。


では、プログラムは下記。

———————————————-
Option Explicit

Sub CreateCalendar()
 CreateMonthSheet
 Dim dt As Date
 Dim c As Long
 For c = 1 To 12
  dt = DateAdd(“m”, c – 1, #1/1/2010#) ‘←年が変わったらここの日付を修正する。
 Worksheets(c & “月”).Activate
 ExeCreateCalendar dt
 Next
End Sub


Sub CreateMonthSheet() ’12月までのシートを作る
 Dim s As Worksheet
 Application.DisplayAlerts = False
 For Each s In Worksheets
  If Left(s.Name, 4) <> “main” Then
  s.Delete
 End If
 Next
 Application.DisplayAlerts = True
 Dim c As Long
 For c = 1 To 12
  Worksheets(“mainスケジュール”).Copy after:=Worksheets(Worksheets.Count)
 ActiveSheet.Name = c & “月”
 Range(“D3″).Value = c & “月”
 Next
 Worksheets(“mainスケジュール”).Activate
End Sub


Sub ExeCreateCalendar(dtFm As Date)
 Dim dtTp As Date
 Dim c As Long
 dtTp = dtFm
  c  = 0

 Dim rgControl As Range
 Set rgControl = Worksheets(“mainControl”).Range(“A1″)
 Dim bHoliday As Boolean

  Do While Month(dtTp) = Month(dtFm)
  Range(“D4″).Offset(, c).Value = Day(dtTp) & “日”
  Range(“D6″).Offset(, c).Value = WeekdayName(Weekday(dtTp), True)
 Range(“D6″).Offset(, c).Select
  Range(“D6″).Offset(, c).Font.ColorIndex =   Worksheets(“mainControl”).Range(“A1″).Offset(Weekday(dtTp)).Font.ColorIndex

  bHoliday = IsHoliday(dtTp)
  If bHoliday = True Then
  ‘With Range(.Offset(c), .Offset(c, 4))
  With Range(“D8:D14″).Offset(, c)
  .Interior.ColorIndex = Worksheets(“mainControl”).Range(“D1″).Interior.ColorIndex
  End With
  Else
  With Range(“D8:D14″).Offset(, c)
  .Interior.ColorIndex = rgControl.Offset(Weekday(dtTp)).Interior.ColorIndex
 End With
 End If
  dtTp = DateAdd(“d”, 1, dtTp)
 c = c + 1
 Loop
End Sub


Function IsHoliday(dTmp As Date) As Boolean
  Dim c As Long
  Dim cMx As Long
 cMx = Worksheets(“mainControl”).Range(“C65536″).End(xlUp).Row

 Dim b As Boolean
 b = False
 For c = 2 To cMx
  If dTmp = Worksheets(“mainControl”).Range(“C” & c).Value Then
  b = True
  Exit For
 End If
 Next
 IsHoliday = b
End Function


Sub deletesheet()
  Dim sh As Worksheet
  Application.DisplayAlerts = False
 For Each sh In Worksheets
  If Left(sh.Name, 4) <> “main” Then
  sh.Delete
 End If
  Next
 Application.DisplayAlerts = False
End Sub

———————————————-

以上・・・てか、
プルグラム読みにくい!!
WordPressのエディタではインデントがしにくいなぁ。。
次回は考えないと。


インデントの話は置いといて、
上記は横書きのスケジュール用ですが、
手直しすれば縦書き用でもいけます。

使用されたい方は上記のプログラムをコピペするか、
もしくは下記アドレスまでご連絡いただければ
上記と同じマクロが入ったサンプルのエクセルデータをお渡しします。
(使う予定は無いけど試しに実際のデータを見てみたい。
動かしてみたい。という方もぜひドウゾ。)

info@bookmarklife.jp


ただし、下記条件にご了承いただける方です。

・最低限の注釈は付けますが技術的なサポート、質問には
 お答えできません。
・独自に調べて書いた部分もあるので世間一般的に見て
 正しいプログラムでは無い可能性もあります。
・簡単で構いませんので本ブログの感想やご意見を
 メールに添えいただければと思います。








ブログを最後までお読みいただき本当にありがとうございます!
初めて当ブログに訪れた方も、何度か当ブログにお越し頂いている方も
もしよろしければRSSリーダーの登録をよろしくお願いいたします!

TwitterとFacebookも併せてお願いいたします。
・Twitter @yoh_bookmark
・Facebook @yoh.bookmark

Related Posts Plugin for WordPress, Blogger...

Leave Comment