VBAワード無効な修飾子エラーが空白のセルを交換する範囲

Question

私がやって実行するコードの小さなセクションを書いています次：

1. は、データブロックの最大サイズを（最後が何であるかを見つけますセルは のデータを持ち、座標はLRowとLColで与えられます）
2. カラム内のデータを検索します（これはカラムの範囲にします）。そして、セルが空白の場合は、上のセルの値を使用しますそれ。
3. 新しいシートを作成して名前を変更します
4. データを表示すると、列k内に「致命的」という単語が含まれている行のみを選択し、これらの行を新しい名前を変更したシートに貼り付けます。

これまでのところ私のコードです。誰も上記の改善を実装することができますか、なぜLRowで無効な修飾子エラーを取得するのか把握できますか？ コードはWord文書から開始され、Excelスプレッドシートを開き、スプレッドシート内のデータを再生します。

グローバルサブを有効にするボタンをクリックします。

Private Sub ObtainFatalCrashInfoButton_Click() 
'Disable screen updating 
'Application.ScreenUpdating = False 
Application.Run ("OpenRawDataFile") 
Application.Run ("FixData") 
Application.Run ("GetData") 
'Application.Run ("CloseRawDataFile") 
Application.Run ("CommandButtonRemove") 
'Enable screen updating 
'Application.ScreenUpdating = True 

End Sub 

その後、次のサブルーチンを順番にアクティブ化されています

Sub OpenRawDataFile() 
'Not sure this works.... 
Set appExcel = CreateObject("Excel.Application") 

Dim IFAM_Index As Variant 

Dim IFAM_File As Variant 

IFAM_File = appExcel.GetOpenFilename("Excel files (*.xls), *.xls") 

appExcel.Workbooks.Open IFAM_File 

End Sub 

サブFixDataを。欠落したデータを追加して、プロセスの次の部分を簡単にします。

Sub FixData() 
Dim i As Long 
Dim LRow As Long, LCol As Long 
Dim rngD As Range 

'Set the range of the "Duration Working" Spreadsheet 
LRow = wb.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row 
LCol = wb.Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column 
Set rngD = Range(Cells(2, 1), Cells(LRow, LCol)) 


For i = 1 To LRow.Rows.Count 
    If LRow.Cells(i, 11).Value = "" Then 
     LRow.Cells(i, 11).Value = LRow.Cells(i - 1, 1).Value 
    End If 
Next 
End Sub 

Sub GetData（） SUbは条件を満たす行を新しいシートにコピーして、必要な形式（この部分はまだ書かれていません）の単語に簡単に抽出できるようにする必要があります。

Sub GetData() 

'Create new tab to copy data to 
Dim WS As Worksheet 

Set WS = Sheets.Add 

'assuming the data is in sheet1 
Sheets("Sheet2").Select 
RowCount = LRow 
For jj = 1 To RowCount 
    'assuming the true statment is in column k 
    Range("k" & jj).Select 
    check_value = ActiveCell 
    If check_value = "Fatal" Or check_value = "fatal" Then 
     ActiveCell.EntireRow.Copy 
     'assuming the data is in sheet2 
     WS.Select 
     RowCount = Cells(Cells.Rows.Count, "k").End(xlUp).Row 
     Range("k" & RowCount + 1).Select 
     ActiveSheet.Paste 
     Sheets("Sheet2").Select 
    End If 
Next 

End Sub 

Sub CopyData（）。書かれている。データを特定の形式の単語にコピーします。誰か提案？

Sub CopyData() 
'....To be written 
End Sub 

Sub CloseRawDataFile。データを必要な形式の単語にコピーする必要があるため、保存せずに未加工のデータファイルを閉じます。

Sub CloseRawDataFile() 

wb.Close SaveChanges:=False 
Set wb = Nothing 

End Sub 

Sub CommandButtonRemove。 Word文書からコマンドボタンを削除します。これは、プロセスが再度必要ないためです。

Sub CommandButtonRemove() 
Dim iShp As Word.InlineShape 
For Each iShp In ActiveDocument.InlineShapes 
If iShp.Type = wdInlineShapeOLEControlObject Then 
    If iShp.OLEFormat.Object.Name = "ObtainFatalCrashInfoButton" Then 
     iShp.Range.Font.Hidden = True 
    End If 
End If 
Next 
End Sub 

最終的に、このコードはデータセットを検索し、条件を満たす内容を所定のテーブルの単語文書に貼り付けます。私は簡単にするためにコードの小さなコンポーネントを分離しようとしました。したがって、コードを検索してこの段階で新しいテーブルに貼り付けることだけを考えます。

まだ書かれていない他の部分の助けも大きな助けになります！

Answer 1

私はこれをあなたのFixDataルーチンの潜在的な修正として掲載します。実際に意図したことをしていなくても、コードの残りの部分を処理するために処理しなければならないことをいくつか考えているかもしれません。

'Force developer to declare every variable that is being used 
Option Explicit 

'Define module-level scoped variables, which will be available to all 
'procedures in this code module 
Private appExcel As Object 
Private wb As Object 
Private LRow As Long 
'Need to define all the constants that are normally available in Excel VBA 
Private Const xlUp As Long = -4162 
Private Const xlToLeft As Long = -4159 

Private Sub ObtainFatalCrashInfoButton_Click() 
    OpenRawDataFile 
    'Disable screen updating 
    appExcel.ScreenUpdating = False 
    FixData 
    'Application.Run ("GetData") 
    'Application.Run ("CloseRawDataFile") 
    'Application.Run ("CommandButtonRemove") 
    'Enable screen updating 
    appExcel.ScreenUpdating = True 
End Sub 

Sub OpenRawDataFile() 
    Set appExcel = CreateObject("Excel.Application") 

    Dim IFAM_Index As Variant 
    Dim IFAM_File As Variant 

    IFAM_File = appExcel.GetOpenFilename("Excel files (*.xls), *.xls") 

    'Create a workbook object that we can refer to 
    Set wb = appExcel.Workbooks.Open(IFAM_File) 
End Sub 

Sub FixData() 
    Dim i As Long 
    'Your question implies that you need LRow to be module-level scope 
    ' so remove declaration from here 
    'Dim LRow As Long, LCol As Long 
    Dim LCol As Long 
    '"As Range" in Word means "As Word.Range". If you are using 
    ' late-binding to access Excel, you need to declare rngD "As Object" 
    'Dim rngD As Range 
    Dim rngD As Object 

    'Set the range of the "Duration Working" Spreadsheet 
    '"Rows" and "Columns" need to be qualified, because Word doesn't know that 
    ' you really mean that to be "appExcel.ActiveWorkbook.ActiveSheet.Rows", etc, 
    ' (and you probably didn't mean that anyway) 
    'LRow = wb.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row 
    'LCol = wb.Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column 
    LRow = wb.Worksheets("Sheet2").Cells(wb.Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row 
    LCol = wb.Worksheets("Sheet2").Cells(1, wb.Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column 
    '"Range" and "Cells" need to be qualified, because Word doesn't know that 
    ' you really mean that to be "appExcel.ActiveWorkbook.ActiveSheet.Range", etc, 
    ' (and you probably didn't mean that anyway) 
    'Set rngD = Range(Cells(2, 1), Cells(LRow, LCol)) 
    Set rngD = wb.Worksheets("Sheet2").Range(wb.Worksheets("Sheet2").Cells(2, 1), wb.Worksheets("Sheet2").Cells(LRow, LCol)) 

    'To save typing, the previous statements could be written as 
    'With wb.Worksheets("Sheet2") 
    ' LRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
    ' LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    ' Set rngD = .Range(.Cells(2, 1), .Cells(LRow, LCol)) 
    'End With 

    'This section was probably meant to work on "rngD" 
    'For i = 1 To LRow.Rows.Count 
    ' If LRow.Cells(i, 11).Value = "" Then 
    '  LRow.Cells(i, 11).Value = LRow.Cells(i - 1, 1).Value 
    ' End If 
    'Next 
    For i = 1 To rngD.Rows.Count 
     If rngD.Cells(i, 11).Value = "" Then 
      rngD.Cells(i, 11).Value = rngD.Cells(i - 1, 1).Value 
     End If 
    Next 
End Sub