簡単に言えば、どんなに頑張っても、Excel マクロを介して MessageBox を表示できません。
ここに私がこれまでに持っている行があります:
MyBox = MessageBox.Show("Stuff", "Title")
このマクロを実行すると、次のエラーが発生します。
実行時エラー '424': オブジェクトが必要です
どうしたの!?!?
完全なコードは次のとおりです。
Sub ImportParser()
'
' ImportParser Macro
' By: Dennis Plotnik (July 2013)
'
Dim ToKeepSize As Integer ' Size of ToKeep array
Dim BlankCount As Integer ' Counts blank lines so as to stop execution after EOF
Dim ReqText As String ' Required String
ReqText = "Import Control"
BlankCount = 0
ToKeepSize = -1
' Dim ToKeep As String()
Dim ToKeep() As String ' Array to store names of tables that include required text
Dim CurrentTable As String ' String to store last required table name
Range("B1").Select
Do
Do ' Go down until come to non-blank row (or exit if all blank)
Selection.Offset(1, 0).Select
Dim tempS As String
tempS = "'" + ActiveCell.Formula
ActiveCell.Value = tempS
If ActiveCell.Value = "" Then
BlankCount = BlankCount + 1
Else
Exit Do
End If
Loop Until BlankCount > 15
If InStr(1, ActiveCell.Value, ReqText, vbTextCompare) > 0 Then ' Check for ReqText in current cell
' ActiveCell.Value = "HELLO!" ' For DEBUG purposes
ToKeepSize = ToKeepSize + 1 ' Increment size of array (to allow for new value)
ReDim Preserve ToKeep(ToKeepSize)
Selection.Offset(0, -1).Select ' Move left to retrieve name of table (category)
CurrentTable = ActiveCell.Value
ToKeep(ToKeepSize) = CurrentTable
For j = 0 To 10000
Selection.Offset(1, 0).Select ' Cycle down until new table is reached
Do
If ActiveCell.Value = "" Then
BlankCount = BlankCount + 1
Selection.Offset(1, 0).Select
Else
Exit Do
End If
Loop Until BlankCount > 15
If ActiveCell.Value <> CurrentTable Then
Selection.Offset(-1, 1).Select ' Return to Field Name to continue search for ReqText
Exit For
End If
Next j
End If
Loop Until BlankCount > 15
' Range("F1").Select ' Print found tables [FOR DEBUG]
' For i = 0 To ToKeepSize
' ActiveCell.Value = ToKeep(i)
' Selection.Offset(1, 0).Select
' Next i
' ActiveCell.Value = CStr(ToKeepSize)
For i = 0 To 1 ' Prepare Table for Flag Columns
Range("A1").EntireColumn.Insert
Next i
Range("A1").Select
ActiveCell.Value = "Import Controlled?"
Range("B1").Select
ActiveCell.Value = "Delete it?"
Columns("A:F").AutoFit
BlankCount = 0
Dim ImportControl As Boolean
ImportControl = False
Range("C1").Select
Do ' Flag necessary columns
Selection.Offset(1, 0).Select
If ActiveCell.Value = "" Then
BlankCount = BlankCount + 1
Else
For i = 0 To ToKeepSize
If ActiveCell.Value = ToKeep(i) Then
Selection.Offset(0, -2).Value = 1
Exit For
End If
Next i
End If
Loop Until BlankCount > 15
Range("A1").Select ' Sort to push all required tables to top of file
Columns("A:A").Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A:F")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Do
Selection.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
MyBox = MessageBox.Show("Stuff", "Title")
Dim file As String
file = Application.ActiveWorkbook.Path
Dim Word As Object: Set Word = CreateObject("Word.Application")
Word.Visible = True
Set docWD = Word.Documents.Add
docWD.SaveAs file & "\" & "dictionary", FileFormat:=wdFormatDocument
Range(ActiveCell.Offset(0, 2), "F1").Copy
Word.Selection.Paste
End Sub