Excelのマクロで、開いた時に、行と日付が入るようにしたい

質問

教えてください。WinXP、Excel2000を使って、A1に日付、B1に記録をつけていて、枠線で囲んで、毎日記録しているのですが、一回一回、行を挿入するのが大変なので、マクロもしくはVBAで、ファイルを開いた瞬間に、自動的に1行挿入され、かつAの列に、その当日の日付が入るようにするにはどうしたらよいでしょうか？

回答No.5

zap35 · ベストアンサー

＃０２です。
ブックを開いたときに指定したシートのB列の最終行の１行下に日付と罫線を入れるマクロにしました。マクロをペーストする方法は＃０２と一緒です

Private Sub Workbook_Open()
Dim LastR As Long
　With Worksheets("Sheet1")　'シート名が違うなら「Sheet1」を修正する
　　LastR = .Range("B65536").End(xlUp).Row
　　.Cells(LastR + 1, 1) = Date
　　Range(.Cells(1, 1), .Cells(LastR + 1, 2)).Borders.LineStyle = xlContinuous
　End With
End Sub

お礼

ありがとうございました。すごく助かりました。

回答No.4

hana-hana3

＞その次の日は3行目に、行を挿入したいのですが、言葉足らずで申し訳ありません。

挿入ではなくて追加ですよね？

Cells(Rows.Count, 1).End(xlUp).Activate
If ActiveCell <> Date And ActiveCell <> "" Then
Rows(Selection.Row).Copy Rows(Selection.Row + 1)
ActiveCell.Offset(1) = Date
ActiveCell.Offset(1, 1).ClearContents
End If

お礼

ありがとうございました。すごく助かりました。

回答No.3

myCat

こんにちは。

今日を入力する為に、前日までの分は一段下げ、
今日は常に一行目（B1)に入力するということですね。

標準モジュールに以下のコードを置いておけば
該当Bookが開いたときに質問のようになります。

-----------------------------------------------
Sub Auto_Open()
　　Range("A1").EntireRow.Insert

　　With Range("A1")
　　　　.Value = Date
　　　　.NumberFormatLocal = "yyyy/m/d"
　　　　.EntireColumn.AutoFit
　　End With

　　With Range("A1:B1").Borders
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　End With

　　Range("B1").Select
End Sub
--------------------------------------------------

コードを見れば分かると思いますが次のようなことをしています。

１行目に１行挿入
A1に今日の日付を代入
A1の表示形式を日付に設定
A列の幅を日付の幅に設定
A1：B1　に罫線を設定
B1に入力できるようにB1をSelectしておく

以上です。

お礼

ありがとうございました。すごく助かりました。

補足

すいません。説明不足でした。その逆です。例えば1行目、2行目にデータを入力したら、その次の日は3行目に、行を挿入したいのですが、言葉足らずで申し訳ありません。

回答No.2

zap35

こんなマクロでしょうか。
マクロはALT＋F11でVBE画面を開き、「VBAProjectエクスプローラのシート名配下のThisWorkbookを右クリック」→「コードの表示」で表示される画面にペーストして下さい。BOOKを開いたときに毎回実行されます

Private Sub Workbook_Open()
Worksheets("Sheet1").Activate　'シート名が違うなら「Sheet1」を修正する
Range("A1:B1").Insert Shift:=xlDown 'A1:B1のセルを挿入
Cells(1, 1) = Date
Range("A1:B1").Borders.LineStyle = xlContinuous　'罫線を引く
End Sub

お礼

ありがとうございました。すごく助かりました。

回答No.1

hana-hana3

下記の文を、シートモジュールの
Private Sub Worksheet_Activate()
などに記述して置けば良いかと思います。

If Range("A1") <> Date Then
Rows("1:1").Copy
Rows("1:1").Insert Shift:=xlDown
Application.CutCopyMode = False
Range("A1") = Date
End If

お礼

ありがとうございました。すごく助かりました。