vbaで標準モジュールの変数を引用したい
vbaを勉強しています。以下のようなコードを書きました。(長くなってしまい申し訳ありません)
ユーザーが指定した日付で工程表を作成したいのですが、イベントプロシージャ?(と呼ぶかどうかよくわからないのですが)がうまく動きません。標準プロシージャのイン尾うっとボックスで取得した日付をイベントプロシージャで使うにはどうしたらよいでしょうか。
また、インプットボックスで日付を指定する際に、既存にある日付を削除してから記述をしたいのですが、どのようにしてよいかわかりませんでした。
↓標準モジュール
Const HIDUKE_ADRS As String = "E2" '日付セル位置
Const MONTH_OFST As Integer = 0 '月の行の位置
Const DAY_OFST As Integer = 1 '日の行の位置
Const WKDAY_OFST As Integer = 2 '曜日の行の位置
Const FIRST_DAY As Integer = 1 '月の変わり目の日
Dim myDate As Date '処理中の日付を表す変数
Dim baseCell '基点セル
Dim LC As Long '最終列
Dim LR As Long '最終行
Sub 日付描画()
Dim orgDate As Date
Dim dstDate As Date
orgDate = InputBox("開始年月日を入力してください。例:2012/5/1")
dstDate = InputBox("終了年月日を入力してください。例:2013/3/31")
Set baseCell = Range(HIDUKE_ADRS) '基点セルを日付にセット
↓以下の作業をする前に、既に記述されている日付を削除したい。
'----------- 月と日と曜日を描画 -----------
baseCell.Activate '基点セルをアクティブセル化
myDate = orgDate 'myDateを開始年月日にセット
Do Until myDate > dstDate '処理中の日が終了年月日に達するまでループを回す
With ActiveCell
'月の変わり目の日と表の最初の行のみ月を描画
If Day(myDate) = FIRST_DAY Or .Column = baseCell.Column Then
.Value = Month(myDate) & "月" '月を入力
.Borders(xlEdgeLeft).Weight = xlThin 'セル左辺に罫線を引く
End If
.Interior.Color = vbBlue
.Offset(DAY_OFST, 0).Value = Day(myDate) '日を入力
.Offset(DAY_OFST, 0).ColumnWidth = 3
.Offset(WKDAY_OFST, 0).Value = WeekdayName(Weekday(myDate), True) '曜日を入力
'日の列~スケジュール欄の列に格子状の罫線を引く
Range(.Offset(DAY_OFST, 0), .Offset(WKDAY_OFST, 0)).Borders.Weight = xlThin
'日曜のセル背景を黄色にする
If Weekday(myDate) = vbSunday Then
Range(.Offset(DAY_OFST, 0), .Offset(WKDAY_OFST, 0)) _
.Interior.Color = vbYellow
End If
myDate = DateAdd("d", 1, myDate) '処理中の日付を1日進める
.Offset(0, 1).Activate 'アクティブセルを1行進める
End With
Loop
End Sub
↓イベントプロシージャ(と呼ぶのでしょうか?)
Private Sub Worksheet_Change(ByVal target As Range)
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
' 工程ライン作成
Dim orgDate As Date
Dim myDate As Date '処理中の日付を表す変数
Dim X1 As Single
Dim Y1 As Single
Dim X2 As Single
Dim Y2 As Single
Dim kiten As Range
Dim Kikan As Long
Dim start As Long
Dim i As Long
Dim LR As Long '最終行
LR = Range("D65536").End(xlUp).Row
Set kiten = Range("E4")
If target.Column = Range("C:D").Column Then
Call 日付描画(orgDate) ←ここが駄目なようです。。
myDate = orgDate
On Error Resume Next
For i = 5 To LR
ActiveSheet.Shapes("KOUTEILine " & i).Delete
Next i
For i = 5 To LR
start = Cells(i, 3).Value - myDate
Kikan = Cells(i, 4).Value - Cells(i, 3).Value
X1 = Range(Cells(1, 1), Cells(1, 4 + start)).Width
Y1 = Range(Cells(1, 1), Cells(i - 1, 1)).Height + Cells(i, 1).Height / 1.1
X2 = Range(Cells(1, 1), Cells(i, start + 5 + Kikan)).Width
Y2 = Y1
With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2)
.Name = "KOUTEILine " & i
.line.EndArrowheadStyle = msoArrowheadTriangle
.line.ThemeColor = xlThemeColorAccent1
.line.Weight = 3
End With
Next i
End If
End Sub
よろしくお願いいたします。
お礼
marbin 様 早速のお返事ありがとうございました。 うまくいきました。本当にありがとうございます。 また、SendKeysメソッドまで教えていただき感謝感謝!!です。 今後とも何卒よろしくお願いします。