Добрый день
В наличие были 2 темы аналогичные на форме изучил ответа не нашел мб не понял
изначально был макрос экспорта из эксель в word затем запуск макроса в word решил их совместить врубил tools references - ofice MS word 16 для форматирования текста
перенес данный код в эксель
при первичном запуске все идеально код проходит создает файл меняет форматы все отлично
но при повторном запуске макроса Word.Application. уходит в ошибку. после завершения ошибки код снова проходит. т.е работает через раз
Основная ошибка идет при повторном обращении Word.Application после завершения 462 ошибки поломки код снова проходит.
Т.е срабатывает через раз.
Если есть какие либо предположения почему повторно не идет подхват приложения. предположение что ошибка где то вначале но из за чего понять не могу.
полный код (без закладок bookmarks)
В наличие были 2 темы аналогичные на форме изучил ответа не нашел мб не понял
изначально был макрос экспорта из эксель в word затем запуск макроса в word решил их совместить врубил tools references - ofice MS word 16 для форматирования текста
перенес данный код в эксель
при первичном запуске все идеально код проходит создает файл меняет форматы все отлично
но при повторном запуске макроса Word.Application. уходит в ошибку. после завершения ошибки код снова проходит. т.е работает через раз
Основная ошибка идет при повторном обращении Word.Application после завершения 462 ошибки поломки код снова проходит.
| Код |
|---|
With objworddoc Word.Application.ScreenUpdating = 0 |
Т.е срабатывает через раз.
Если есть какие либо предположения почему повторно не идет подхват приложения. предположение что ошибка где то вначале но из за чего понять не могу.
полный код (без закладок bookmarks)
| Код |
|---|
Sub protokol_sverxnorma_na_obshestvo_bez_decretatest() ' создание Протокол сверх норм на общество без декрета
ActiveWorkbook.Sheets("system_substitution").Visible = xlSheetVisible
Dim path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail As String
Dim save_path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail As String
Dim name_protokol_sverxnorma_na_obshestvo_bez_decreta_fail As String
Dim objwrdapp As Word.Application
Dim objworddoc As Word.Document
'activeworkbook.Path &"\" ткущее местоположение
'path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail = ActiveWorkbook.Sheets("экспорт_ворд").Range("protokol_sverxnorma_na_obshestvo_bez_decreta_fail") ' указываем страницу и путь к нашему файлу
path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail = ActiveWorkbook.Path & "\"
save_path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail = ActiveWorkbook.Path & "\" ' указываем путь и путь к сохранению файла
'save_path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail = ActiveWorkbook.Sheets("экспорт_ворд").Range("rik_save_fail") вручную
name_protokol_sverxnorma_na_obshestvo_bez_decreta_fail = "Протокол сверх норм на общество без декрета" ' название нашего шаблона
Set objwrdapp = CreateObject("Word.Application") ' создание вордовского документа из приложения
On Error Resume Next
Set objwrdapp = GetObject(, "Word.Application")
If Err <> 0 Then
Set objwrdapp = CreateObject("Word.Application")
End If
On Error GoTo 0
objwrdapp.Visible = True 'делали наш объект видимым
objwrdapp.Application.Activate
Set objworddoc = objwrdapp.Documents.Open(path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail & name_protokol_sverxnorma_na_obshestvo_bez_decreta_fail & ".docx") 'прописываем путь к нашему объекту для открытия.
With objworddoc
Word.Application.ScreenUpdating = 0
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\блок подстановки закладок
.bookmarks("Н_О_1").Range.Text = ActiveWorkbook.Sheets("system_substitution").Range("Q510")
'убраны из темы так как очень много их
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\работа с ворд документом
'objworddoc
objworddoc.Select
'Word.Application.ScreenUpdating = 0
Dim Таблица As Word.Table
For Each Таблица In objworddoc.Tables
With Таблица
.Rows.WrapAroundText = False
.AutoFitBehavior (wdAutoFitWindow)
.Rows.HeightRule = wdRowHeightAuto
With .Range.Font
.name = "times new roman"
.Size = 12
End With
End With
Word.Selection.WholeStory
With Word.Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Next Таблица
Dim pr As Word.Paragraph
Dim j1 'текст в таблице
Dim s1 'текст параграфа
For Each pr In objworddoc.Paragraphs
pr.Range.Select
j1 = Word.Selection.Information(wdWithInTable)
s1 = pr.Range.Text
'Отделение таблиц, рисунков и пустых строк
If j1 = False And Len(s1) > 3 Then
'(Обработка выделенного фрагмента)
' MsgBox ("Обработка выделенного фрагмента")
Word.Selection.Font.name = "Times New Roman"
Word.Selection.Font.Size = 12
With Word.Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceAtLeast
.FirstLineIndent = CentimetersToPoints(1.25)
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
' .Font.Size = 12
' .Font.name = "times new roman"
End With
End If
Next pr
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\удаление двойных абзацев
For pk = 1 To 20
Word.Selection.WholeStory
Word.Selection.Find.ClearFormatting
Word.Selection.Find.Replacement.ClearFormatting
With Word.Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Word.Selection.Find.Execute Replace:=wdReplaceAll, _
Forward:=True, Wrap:=wdFindNext
With Word.Selection.Find
.Text = "^p ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Word.Selection.Find.Execute Replace:=wdReplaceAll, _
Forward:=True, Wrap:=wdFindNext
With Word.Selection.Find
.Text = " ^p ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Word.Selection.Find.Execute Replace:=wdReplaceAll, _
Forward:=True, Wrap:=wdFindNext
With Word.Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Word.Selection.Find.Execute Replace:=wdReplaceAll, _
Forward:=True, Wrap:=wdFindNext
Next pk
'ActiveDocument.Paragraphs.CharacterUnitFirstLineIndent = 1.25
objworddoc.PageSetup.RightMargin = CentimetersToPoints(1)
objworddoc.PageSetup.LeftMargin = CentimetersToPoints(3)
'ActiveDocument.Paragraphs.FirstLineIndent = CentimetersToPoints(1.25)
Word.Application.ScreenUpdating = 1
objworddoc.SaveAs Filename:=save_path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail & "Протокол сверх норм на общество без декрета по инвентаризации " & ActiveWorkbook.Sheets("AKT_zacheta").Range("N6") & " " & ActiveWorkbook.Sheets("AKT_zacheta").Range("N1") & ".docx"
End With
objworddoc.Close SaveChanges:=False
objwordapp.Quit
objworddoc.Quit
Word.Application.Quit
Kill path_protokol_sverxnorma_na_obshestvo_bez_decreta_fail & name_protokol_sverxnorma_na_obshestvo_bez_decreta_fail & ".docx"
ActiveWorkbook.Sheets("system_substitution").Visible = xlVeryHidden
ActiveWorkbook.Sheets("dynamick_tb_system_substitution").Visible = xlVeryHidden
Set objwrdapp = Nothing
Set objworddoc = Nothing
End Sub
|
Изменено: - 29.08.2024 12:15:56
