[英]VBA word Invalid Qualifier error using Dynamic Ranges to replace blank cells
我正在編寫一小段代碼,它將通過執行以下操作運行:
下面是到目前為止的代碼。 誰能實現我上面提到的改進,並弄清楚為什么我使用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
子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
子CopyData()。 待寫。 將以特定格式將數據復制到單詞。 有任何建議嗎?
Sub CopyData()
'....To be written
End Sub
子CloseRawDataFile。 關閉原始數據文件而不保存,因為現在應該將數據復制為所需格式的word。
Sub CloseRawDataFile()
wb.Close SaveChanges:=False
Set wb = Nothing
End Sub
子CommandButton刪除。 從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
最終,此代碼將搜索數據集並將符合條件的內容粘貼到預定義表中的word文檔中。 在我嘗試簡化代碼時,我嘗試將其分離出來。 因此,現階段只需要搜索代碼並將其粘貼到新表中。
其他方面尚待編寫的任何幫助也將是巨大的幫助!
我將其發布為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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.