VB6.0 Excel 同シートで毎回改行して書き込む方法

質問

こんにちは。VB6.0(SP5)、Excel2003、WindowsXPでVBの勉強をしています。
現在、VBでコマンドボタンを押した時に、Excelに押した時の時間を書き込むプログラムを作成しています。
一応プログラムを組むことができたのですが、再びコマンドボタンを押すと2回目以降書き込んだ時間を上書きするものです。
コマンドボタンを押した時、時間の書き込みを毎回次の行で行うプログラムを組みたいと思っています。
毎回改行して書き込むためには、どのようにプログラムを書くと良いでしょうか？
ご指導よろしくお願いします。

組んだプログラムを下記に記します。

Private Sub Command1_Click()

Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSheet As Object

On Error Resume Next

Set xlsApp = GetObject(, "Excel.Application")
Set xlsBook = xlsApp.ActiveWorkbook
Set xlsSheet = xlsBook.Sheets.Add
If Err.Number <> 0 Then
Set xlsBook = xlsApp.Workbooks.Add
Set xlsSheet = xlsBook.ActiveSheet
End If

Call Excel(xlsBook, xlsSheet)

Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
On Error GoTo 0

End Sub

Private Sub Excel(xlsBook As Object, xlsSheet As Object)

Dim hh As Single
Dim mm As Single
Dim ss As Single

xlsSheet.Range("A1") = Format(Time, "hh:mm:ss")

End Sub

回答No.2

hotosys · ベストアンサー

こんなんではどうでしょうか？
on error の期間はできるだけ短くした方がいいと思います。
excelサブルーチンにはxlsBookを渡す必要はないと思います。
もしも必要ならxlsSheet.Parentで取得できると思います。

Private Sub Command1_Click()
Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSheet As Object
'excel の取得
On Error Resume Next
Set xlsApp = GetObject(, "Excel.Application") '起動中のExcel取得
If Err.Number <> 0 Then 'エラーなら
Set xlsApp = CreateObject("Excel.Application") '新たにExcel起動
xlsApp.Visible = True '表示する
End If
On Error GoTo 0
If xlsApp.workbooks.Count = 0 Then 'ブックが無い場合は
Set xlsBook = xlsApp.workbooks.Add 'ブックを追加
Else
Set xlsBook = xlsApp.ActiveWorkbook 'ActiveWorkbookを取得
End If
Set xlsSheet = xlsBook.ActiveSheet 'ActiveSheet取得
Call Excel(xlsSheet)
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
End Sub

Private Sub Excel(xlsSheet As Object)
Const xlUp = -4162 'FFFFEFBE
If xlsSheet.Range("A1").Value = "" Then 'A1が空白なら
xlsSheet.Range("A1") = Format(Time, "hh:mm:ss") 'A1に表示
Else '違ったら
xlsSheet.Range("A" & xlsSheet.rows.Count).End(xlUp).offset(1, 0) = Format(Time, "hh:mm:ss") 'A列の最終行の1つ下のセルに表示
End If
End Sub

補足

補足と言うより質問なのですが、
A列に時間を表示しましたが、同時に別の列（例えば、B列）に何か文字を書き込みたい場合、
Private Sub Excel(xlsSheet As Object)以降のプログラムで、
A列関連のプログラムと同様のB列関連のプログラムを書けばよろしいのでしょうか？

回答No.3

hotosys

No.2です。
xlsSheet.Range("A" & xlsSheet.rows.Count).End(xlUp)
がA列の最終セルなので、
xlsSheet.Range("A" & xlsSheet.rows.Count).End(xlUp).offset(1, 0)
で、その１つ下のセルに時間を書いたので
そのセルか行を変数に取得して
Dim r As Long
r = xlsSheet.Range("A" & xlsSheet.rows.Count).End(xlUp).Offset(1, 0).Row
xlsSheet.Range("A" & r).Value = Format(Time, "hh:mm:ss")
xlsSheet.Range("B" & r).Value = "何か文字列"
とするか
With xlsSheet.Range("A" & xlsSheet.Rows.Count).End(xlUp).Offset(1, 0) 'A列の最終行の1つ下のセル
.Value = Format(Time, "hh:mm:ss")
.Offset(0, 1).Value = "何か文字列" 'さらに右となりのセル(B列)
End With
ではどうでしょうか？

p.s.
回答が遅くなりましたが、教えて！gooが開かない(遅い)事が多くて・・・

お礼

まだまだ勉強不足ですが、この様に丁寧に教えていただくと「なるほど！」と得心がいきます。

こちらもお礼が遅れてしまい失礼しました。
ありがとうございます。

回答No.1

laputart

一例ですが
---------------------------------
Dim Ct As Integer
Dim hh, mm, ss As Integer
Dim CellName As String
Sub TimeWrite()
'ボタンを押したとき

'カウントの所得
Ct = Range("A1").Value

'カウントを１つ増やす
Ct = Ct + 1

'カウントを書き込む
Range("A1").Value = Ct

'セル文字列の作成
CellName = "B" & CStr(Ct) + 1

'書き込み
Range(CellName) = Format(Time, "hh:mm:ss")
End Sub
'-------------------------------------
※セルA0をカウンターとして使用します。
※　A0に0を入れます。
※ボタンを押すとA0の値を読んで ctに入力
ct=ct+1としてA0の値を偏光します。
※次に　ctを利用して時刻を書き込むセルを指定します。
この場合
CellName = "B" & CStr(Ct) + 1
あなたのプログラムの一番最後から2行目は
xlsSheet.Range("A1") = Format(Time, "hh:mm:ss")
はセルA1に時刻を書き込むことになっていますので
常に上書きされます。
この　"A1" を変数にするのです。
としてCelNameという変数に　"B2"から順に下に送っていくものです。
あくまでもテストですから完璧ではありません。

お礼

回答ありがとうございます。

Range("")の()内をどう自動で変えれば良いのかわからなかったのですが、
大変参考になりました。