VBA アプリケーション定義またはオブジェクト定義のエラーです
VBA初心者です。
仕事中、暇な時にVBAの勉強をしています。
あるファイルのフォーマットを指定されたフォーマットに変換するプログラムを作成しています。
実行後、「アプリケーション定義またはオブジェクト定義のエラーです」と出て、先に進めません。
どなたが分かる方、ご教授お願い致します。
以下ソース
Private Sub CommandButton1_Click()
' 変数定義
Dim openFileName As String
Dim priorYearBudget As String, thisYearBudget As String, increaseAnddecrease As String
Dim bigSection As String, mediumSection As String, smallSection As String
Dim fileLastRow As Long, buf As Long, index As Long
Dim head As String
' 初期化
index = 2
' ファイル名取得
openFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
If openFileName <> "False" Then
' ファイルが存在したらファイルを開く
Workbooks.Open openFileName
' 項目を変数に格納
' bigSection = Sheets(1).Cells(1, 3)
' mediumSection = Sheets(1).Cells(1, 4)
' smallSection = Sheets(1).Cells(1, 5)
priorYearBudget = Sheets(1).Cells(1, 6)
thisYearBudget = Sheets(1).Cells(1, 7)
increaseAnddecrease = Sheets(1).Cells(1, 8)
' ファイルの最終行を取得(データが格納されている行)
fileLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
' ワークシートの追加
Worksheets.Add after:=Worksheets("Sheet1")
' セルの幅指定
Columns("A").Select
Selection.ColumnWidth = 70
Columns("B:D").Select
Selection.ColumnWidth = 13
Columns("A").Select
' 幅設定で選択されたセルを解除
range("A1").Select
' 新規に追加されたワークシートに項目を設定
Sheets(2).Cells(1, 1).Value = "勘定科目"
Sheets(2).Cells(1, 2).Value = priorYearBudget
Sheets(2).Cells(1, 3).Value = thisYearBudget
Sheets(2).Cells(1, 4).Value = increaseAnddecrease
' 元ファイルの見出しの形式を変更
For headCnt = 1 To fileLastRow
head = Sheets(1).Cells(headCnt, 1)
bigSection = Sheets(1).Cells(index, 3)
midiumSection = Sheets(1).Cells(index, 4)
smallSection = Sheets(1).Cells(index, 5)
If head <> "" Then
' 項目設定
Sheets(2).Cells(headCnt, 1).Value = "【" & head & "】"
End If
If bigSection <> "" Then
' 大区分設定
Sheets(2).Cells(buf, 1).Value = bigSection←ここでエラー発生
ElseIf midiumSection <> "" Then
' 中区分設定
Sheets(2).Cells(buf, 1).Value = midiumSection
ElseIf smallSection <> "" Then
' 小区分設定
Sheets(2).Cells(buf, 1).Value = smaillsection
End If
' Sheets(2).Cells(cnt, 1).Value = head
' head = Sheets(1).Cells(cnt, 1)
index = index + 1
buf = buf + 1
Next headCnt
' 元ファイルの金額をそのままコピー
For budgetCnt = 2 To fileLastRow
Sheets(2).Cells(budgetCnt, 2).Value = Sheets(1).Cells(budgetCnt, 6)
Sheets(2).Cells(budgetCnt, 3).Value = Sheets(1).Cells(budgetCnt, 7)
Sheets(2).Cells(budgetCnt, 4).Value = Sheets(1).Cells(budgetCnt, 8)
Next budgetCnt
Else
MsgBox "キャンセルされました"
Exit Sub
End If
End Sub
補足
エラーが発生する箇所をコメントアウトすると、正常に動作します。
よろしくお願い致します。
お礼
大変勉強になります、ありがとうございます。