1

Word.Documents への参照を VBA のサブに渡そうとしています (これにより、常に同じ「ターゲット」Word ドキュメントと異なる「ソース」ドキュメントを使用して、サブを複数回実行できます)。

Public Sub StructuredFileParse(wrdDocSource As Word.Document, _
                            Optional wrdDocTarget As Word.Document = Nothing)

Dim wrdApp As Object

Set wrdApp = wrdDocSource.Application

If wrdDocTarget Is Nothing Then
    Set wrdDocTarget = wrdApp.Documents.Add
End If

wrdDocTarget.Activate
With wrdApp.Selection.PageSetup
    .LeftMargin = CentimetersToPoints(2#) 'Code fails here second time it runs
    .RightMargin = CentimetersToPoints(2#)
End With

'Do stuff

Set wrdApp = Nothing

End Sub

Public Sub TestSub()

Const ERR_APP_NOTFOUND As Long = 429

Dim wrdApp As Word.Application

Dim wrdDocSource As Word.Document
Dim wrdDocTarget As Word.Document

On Error Resume Next
' Attempt to reference running instance of Word.
Set wrdApp = GetObject(, "Word.Application")
' If Word isn't running, create a new instance.
If Err = ERR_APP_NOTFOUND Then
   Set wrdApp = New Word.Application
End If
On Error GoTo 0

wrdApp.Visible = True

'Create a new word target file
Set wrdDocTarget = wrdApp.Documents.Add

'Set the first word source file
Set wrdDocSource = wrdApp.Documents.Open(ThisWorkbook.Path & "\" & _
                    "AdvisorChargeQuoteSource.dot")

Call StructuredFileParse(wrdDocSource:=wrdDocSource, wrdDocTarget:=wrdDocTarget)

wrdDocSource.Close

Set wrdDocSource = Nothing
Set wrdDocTarget = Nothing
Set wrdApp = Nothing
End Sub

サブルーチンを初めて呼び出すと、すべてが意図したとおりに機能します。ただし、2 回目には、上記の PageSetup 部分の最後でエラーが発生します (エラー テキストはなく、[OK]/[ヘルプ] ウィンドウだけが表示され、実行が停止します)。

誰でも間違いを強調できますか？

ありがとう

スティーブ

編集: http://support.microsoft.com/kb/189618にある解決策

かわった

With wrdApp.Selection.PageSetup
    .LeftMargin = CentimetersToPoints(2#) 'Code fails here second time it runs
    .RightMargin = CentimetersToPoints(2#)
End With

に

With wrdApp.Selection.PageSetup
    .LeftMargin = wrdApp.CentimetersToPoints(2#)
    .RightMargin = wrdApp.CentimetersToPoints(2#)
End With

これまでのところ、毎回エラーなく実行されているようです。

4

1 に答える 1

0

http://support.microsoft.com/kb/189618にある解決策

かわった

With wrdApp.Selection.PageSetup
    .LeftMargin = CentimetersToPoints(2#) 'Code fails here second time it runs
    .RightMargin = CentimetersToPoints(2#)
End With

に

With wrdApp.Selection.PageSetup
    .LeftMargin = wrdApp.CentimetersToPoints(2#)
    .RightMargin = wrdApp.CentimetersToPoints(2#)
End With

これまでのところ、毎回エラーなく実行されているようです。

于 2013-02-25T09:57:27.083 に答える