1

TextBox から Excel にテキストを挿入するサンプル VB6 アプリケーションをテストしています。列で最後に使用された行を見つけて、txt1ユーザーがボタンをクリックするたびに次の行に TextBox からテキストを追加したいと思います。範囲はC10～C49です。最後の行が入力された後、ユーザーに新しい Excel ファイルを開くように求めます。

追加部分を行うことができません。以下は私が試したコードです： 

Private Sub cmdUpdate_Click()
  Dim objConn As New ADODB.Connection
  Dim szConnect As String

  szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\Excel\Format.xls;" & _
        "Extended Properties='Excel 8.0;HDR=NO';"

  objConn.Open szConnect

  Dim xrow As Integer
  Dim lastRow As Integer
  lastRow = 10
  xrow = 49
  Do while lastRow <= xrow
    objConn.Execute "UPDATE [Sheet1$C" & lastRow & ":C" & lastRow & "] SET F1 =" &      txt1.Text & ";"
    lastRow = lastRow + 1
  Loop 
End Sub

コードは、更新ごとに範囲全体を埋めます。私は自分の間違いがどこにあるかを知っていますが、適切な方法を理解できません。行まで一度だけ挿入する方法は49？

ワークブックがExcelで開いているときに更新できるようにしたいので、Excelオブジェクトモデルを使用することはオプションではありません。

4

1 に答える 1

0

これを実現する簡単な方法は、より可視的であると宣言しlastRow(たとえば、フォーム クラスのプライベート メンバーとして)、ループを削除し、lastRow更新ごとに 1 回だけインクリメントすることです。

Private lastRow As Integer
'...
objConn.Execute _
    "UPDATE [Sheet1$C" & lastRow & ":C" & lastRow _
    & "] SET F1 =" & txt1.Text & ";"
lastRow = lastRow + 1

対象の Excel 範囲を完全に制御できない場合 (たとえば、範囲内のデータが更新の間に変更される可能性があり、それらの変更を上書きしたくない場合)、更新のたびに最初の空のセルを検索できます。IsNull()空のセルをテストするために使用します。

Private Const RANGE_IS_FULL     As Long = -1

' Returns first vacant position in sRange Excel range (zero-based)
' Returns RANGE_IS_FULL if no vacant position was found
' sConnectionString: connection string to Excel workbook
' sRange: Excel range of a form [Sheet1$C10:C49]
Private Function GetNextAppendPosition(sConnectionString As String _
    , sRange As String) As Long
    Dim lRow As Long
    Dim oRS As ADODB.Recordset

    Set oRS = New ADODB.Recordset
    oRS.CursorLocation = ADODB.adUseClient

    oRS.Open "SELECT F1 FROM " & sRange _
        , sConnectionString

    oRS.MoveFirst
    GetNextAppendPosition = RANGE_IS_FULL
    lRow = -1
    While Not oRS.EOF
        lRow = lRow + 1
        If IsNull(oRS.Fields(0).Value) Then
            GetNextAppendPosition = lRow
            GoTo hExit
        End If
        oRS.MoveNext
    Wend

hExit:
    oRS.Close
End Function

これを念頭に置いて、更新ルーチンは次のようにコーディングできます。

Public Sub ExportTextToExcelRow(sText As String)
    Const CONNECTION_STRING As String = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\src\Excel ADO\Book1.xls;" & _
        "Extended Properties='Excel 8.0;HDR=NO';    "
    Const MAX_TARGET_ROW    As Long = 49
    Const MIN_TARGET_ROW    As Long = 10
    Const TARGET_COL        As String = "C"
    Const TARGET_SHEET      As String = "Sheet1"

    Dim lRow As Long
    Dim oConn As New ADODB.Connection
    Dim sTargetRange As String

    sTargetRange = "[" & TARGET_SHEET & "$" & TARGET_COL & MIN_TARGET_ROW _
        & ":" & TARGET_COL & MAX_TARGET_ROW & "]"
    lRow = GetNextAppendPosition(CONNECTION_STRING, sTargetRange)
    If lRow = RANGE_IS_FULL Then
        MsgBox "Oops, range is full."
        Exit Sub
    End If
    lRow = lRow + MIN_TARGET_ROW

    sTargetRange = "[" & TARGET_SHEET & "$" & TARGET_COL & lRow _
        & ":" & TARGET_COL & lRow & "]"

    oConn.Open CONNECTION_STRING
    oConn.Execute "UPDATE " & sTargetRange & " SET F1 = """ & sText & """;"
    oConn.Close
End Sub

この方法でイベント ハンドラーから呼び出します。

Private Sub cmdUpdate_Click()
    ExportTextToExcelRow txt1.Text
End Sub
于 2013-04-13T10:28:48.250 に答える