1

情報を次の行にオフセットする方法がわかりません。

私がやろうとしているのは、このマクロが実行されるたびに、次の行に同じ情報を挿入することです。私は eLearning コースの完了を追跡するための安価な学習管理システムとして使用しているため、ユーザーがマクロを実行するたびに、日付、コース、およびユーザー名が一覧表示されます。

の情報.Cells(1, 1)は正しくありませんが、マクロの残りの部分が機能していることを確認するために使用しました。この時点で、マクロが実行されるたびに 1 行下に移動するロジックを組み込む方法を理解する必要があります。

よろしくお願いします。

Sub Test()
    Dim objNetwork
    Set objNetwork = CreateObject("WScript.Network")
    strUserName = objNetwork.UserName

    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("G:\Training\GPL\Test.xlsx")
    objExcel.Application.DisplayAlerts = False
    objExcel.Application.Visible = False
    objWorkbook.Worksheets(1).Activate
    objWorkbook.Worksheets(1).Cells(1, 1).Value = "GPL Overview"
    objWorkbook.Worksheets(1).Cells(1, 2).Value = strUserName
    objWorkbook.Worksheets(1).Cells(1, 3).Value = Date

    'objExcel.ActiveWorkbook.Save "G:\Training\GPL\Test.xlsx"
    objExcel.ActiveWorkbook.SaveAs "G:\Training\GPL\Test.xlsx"
    objExcel.ActiveWorkbook.Close
    'objExcel.ActiveWorkbook.

    'objExcel.Application.Quit
    'WScript.Echo "Finished."
    'WScript.Quit

    objExcel.Application.Quit
End Sub
4

2 に答える 2

3

これで問題が解決するはずです。これを直後に追加objWorkbook.Worksheets(1).Activate 

Dim lastrow as Long
lastrow = objExcel.Worksheets(1).Range("A" & objExcel.Worksheets(1).Rows.Count).End(xlup).Row + 1

次の 3 行を次のように変更します。

objWorkbook.Worksheets(1).Cells(lastrow, 1).Value = "GPL Overview"
objWorkbook.Worksheets(1).Cells(lastrow, 2).Value = strUserName
objWorkbook.Worksheets(1).Cells(lastrow, 3).Value = Date

アップデート

このコードを Excel 自体の内部で実行しているように見えるので、このコードを実際にクリーンアップして、実行速度を上げて解読しやすくする方法を紹介します。以下のコードを参照してください。

Option Explicit

Sub Test()

Dim strUserName as String
strUserName = ENVIRON("username")

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Dim objWorkbook as Workbook
Set objWorkbook = Workbooks.Open("G:\Training\GPL\Test.xlsx")

Dim wks as Worksheet
Set wks = objWorkbook.Sheets(1)

With wks
    Dim lastrow as Long
    lastrow = .Range("A" & .Rows.Count).End(xlup).Row + 1

    .Cells(lastrow, 1).Value = "GPL Overview"
    .Cells(lastrow, 2).Value = strUserName
    .Cells(lastrow, 3).Value = Date

End WIth

objWorkbook.Close True

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub
于 2012-10-22T23:58:28.993 に答える
1

スコット・ホルツマン
に感謝します。いくつかの設定を変更する必要がありましたが、同様の問題が発生しましたが、数日後にあなたは私の救助に来ました。本当に助けてくれてありがとう。
これが私が実装したコードで、あなたの返事が私を助けてくれました。

Private Sub Btn_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_Save.Click

        Dim MyExcel As Microsoft.Office.Interop.Excel.Application
        MyExcel = New Microsoft.Office.Interop.Excel.Application
        Dim wb As Microsoft.Office.Interop.Excel.Workbook
        wb = MyExcel.Workbooks.Open("C:\Users\IMTIYAZ\Desktop\try")
        Dim ws As Microsoft.Office.Interop.Excel.Worksheet
        ws = wb.Sheets("sheet1")
        With ws
            Dim irow As Long
            irow = ws.Range("A65536").End(Excel.XlDirection.xlUp).Offset(1, 0).Select
            irow = ws.Range("A" & ws.Rows.Count).End(Excel.XlDirection.xlUp).Row + 1
            ws.Cells(irow, 1).Value = Me.txtSn.Text
            ws.Cells(irow, 2).Value = Me.txtNa.Text
            ws.Cells(irow, 3).Value = Me.txtGpf.Text
            ws.Cells(irow, 4).Value = Me.txtBa.Text
            ws.Cells(irow, 5).Value = Me.txtBn.Text
            ws.Cells(irow, 6).Value = Me.txtAp.Text
            ws.Cells(irow, 7).Value = Me.txtBp.Text
            ws.Cells(irow, 8).Value = Me.txtGp.Text
            ws.Range(irow, 9).Formula = ("=$G$3+$H$3")
            Me.Lbl_Tt.Text = ws.Cells(irow, 9).Value
            ws.Cells(irow, 10).Value = Me.txtPp.Text
            ws.Cells(irow, 11).Value = Me.txtDa.Text
            ws.Cells(irow, 12).Value = Me.txtMa.Text
            ws.Cells(irow, 13).Value = Me.txtRa.Text
            ws.Cells(irow, 14).Value = Me.txtCa.Text
            ws.Cells(irow, 15).Value = Me.txtOa.Text
            ws.Cells(irow, 16).Formula = ("=i3+J3+K3+L3+M3+N3+O3")
            Me.Lbl_Gt.Text = ws.Cells(irow, 16).Value
            ws.Cells(irow, 17).Value = Me.txtFa.Text
            ws.Cells(irow, 18).Formula = ("=P3-Q3")
            Me.Lbl_Naf.Text = ws.Cells(irow, 18).Value
            ws.Cells(irow, 19).Value = Me.txtSf.Text
            ws.Cells(irow, 20).Value = Me.txtRf.Text
            ws.Cells(irow, 21).Value = Me.txtSi1.Text
            ws.Cells(irow, 22).Value = Me.txtSi2.Text
            ws.Cells(irow, 23).Value = Me.txtSi3.Text
            ws.Cells(irow, 24) = ("=S3+T3+V3+W3+U3")
            Me.Lbl_Td.Text = ws.Cells(irow, 24).Value
            ws.Cells(irow, 25).Formula = ("=R3-X3")
            Me.Lbl_Nad.Text = ws.Cells(irow, 25).Value
            ws.Cells(irow, 26).Value = Me.txtHl.Text
            ws.Cells(irow, 27).Value = Me.txtCsc.Text
            ws.Cells(irow, 28).Value = Me.txtMr.Text
            ws.Cells(irow, 29).Value = Me.txtIt.Text
            ws.Cells(irow, 30).Formula = ("=Y3-(AC3+Z3+AA3+AB3)")
            Me.Lbl_Np.Text = ws.Cells(irow, 30).Value
            MessageBox.Show("The last row in Col A of Sheet1 which has data is " & irow)
        End With
        MyExcel.Quit()
        MyExcel = Nothing
        Me.Update()
    End Sub
End Class
于 2013-01-14T03:50:03.180 に答える