Повторное выполнение макроса

[Jaroslav]

Пишу макрос на VBA в Excel. При повторном (сразу после первого) выполнении макроса открывается только документ Акт.doc и робота макроса прекращается. А если после первого выполнения закрыть Excel, открыть Excel и снова выполнить макрос – макрос работает корректно. В чем тут проблема?

Option Explicit
Sub Akty()
'
' Макрос3 Макрос
' Макрос записан 04.12.2008 Svitlana
'
Dim WordApp As Object
Dim akt As String
 
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
 akt = "D:\audit_2\data\ЛДЗ\0903\Акт"
    Set WordApp = CreateObject("Word.application")
    With WordApp
            .Documents.Open Filename:=akt
            .Visible = True
            .Selection.Find.ClearFormatting
            With .Selection.Find
                .ClearFormatting
                .ParagraphFormat.LineSpacing = LinesToPoints(0.06)
                .Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            While .Selection.Find.Execute
                .Selection.Delete
                DoEvents
            Wend
            .Selection.Find.ClearFormatting
            .Selection.Find.Font.Size = 1
            .Selection.Find.Replacement.ClearFormatting
            With .Selection.Find
                .Text = ""
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
            End With
            .Selection.Find.Execute Replace:=wdReplaceAll
            .Selection.WholeStory
            .Selection.Font.Name = "Times New Roman"
            .Selection.Font.Size = 12
        .ActiveDocument.Close False
    End With
    WordApp.Quit
    Set WordApp = Nothing
handleCancel:
    If Err = 18 Then
        WordApp.Quit
        Set WordApp = Nothing
    End If
End Sub

[viter.alex]

Несколько ошибок.
Поскольку вы выполняете этот макрос из Excel, не подключая библиотеку с объектами Word, то должны помнить, что Excel не знает, что такое LinesToPoints, wdReplaceAll, wdFindContinue и прочие вордовские штуки. Поэтому вместо LinesToPoints нужно писать WordApp.LinesToPoints, т.к. это встроенный метод вашего приложения Word. А вместо wdReplaceAll, wdFindContinue их числовые значения. Собственно это и вызывало у вас 18 ошибку: «Object doesn't support this property or method»
Кроме того, желательно полностью указывать имя файла, который открываете.
Ну и весь макрос, как мне кажется, можно сократить

Sub AktyNew()
'
' Макрос3 Макрос
' Макрос записан 04.12.2008 Svitlana
'
    Dim WordApp As Object
    Dim akt As String
    Dim wdDoc As Object
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler
    akt = "D:\audit_2\data\ЛДЗ\0903\Акт"
    Set WordApp = CreateObject("Word.application")
    Set wdDoc = WordApp.Documents.Open(Filename:=akt)
    With wdDoc.Range.Find
      .ParagraphFormat.LineSpacing = WordApp.LinesToPoints(0.06)
      .Execute Replace:=2 'wdReplaceAll
    End With
    With wdDoc.Range.Find
      .Font.Size = 1
      .Execute Replace:=2 'wdReplaceAll
    End With
    wdDoc.Content.Font.Name = "Times New Roman"
    wdDoc.Content.Font.Size = 12
    wdDoc.Close True
    Set wdDoc = Nothing
    WordApp.Quit
    Set WordApp = Nothing
handleCancel:
    If Err = 18 Then
        WordApp.Quit
        Set WordApp = Nothing
    End If
End Sub

[Jaroslav]

Спасибо, Viter.alex. Буду пробовать

[Jaroslav]

Viter.alex, дело в том, что библиотека Microsoft Word 11.0 Object Library у меня подключена. Если я запущу макрос из екслеля 1 раз - у меня все работает, а вот при повторном запуске макроса (ексель я не закрываю) открывается только документ Акт.doc и робота макроса прекращается. Я писал макрос в ворде, а потом перенес его в ексель