Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > MS Access > VBA Процедура разбивки документа

Автор: Ethex 14.8.2017, 15:08

Доброго времени суток
Имеется код для постраничной разбивки файла word. Тестировал процедуру в mdb - всё работает.

Код


Public Sub SIP()
Dim app As Word.Application
Dim wd As Word.Document
Dim cd As Word.Document
Dim wr As Word.Range
Dim i As Integer
Dim cnt As Integer
Dim fn As String
Set app = CreateObject("Word.Application")
Set wd = app.Documents.Open(Forms![ImpWord2].[Поле2].Value)
Set wr = wd.Range
i = 1
cnt = wd.Content.ComputeStatistics(wdStatisticPages)
SysCmd acSysCmdClearStatus
SysCmd acSysCmdInitMeter, "Страницы документа", cnt
   Do Until i > cnt
   SysCmd acSysCmdUpdateMeter, i
      If i = cnt Then
      wr.End = wd.Range.End
      Else
      Selection.Goto wdGoToPage, wdGoToAbsolute, i + 1
      wr.End = Selection.Start
      End If
wr.Copy
Set cd = Documents.Add
cd.Range.Paste
cd.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
fn = Replace(wd.FullName, ".doc", "_" & i & ".doc")
cd.SaveAs fn
i = i + 1
Me!Список0.AddItem Item:=fn
cd.Close
wr.Collapse wdCollapseEnd
Loop
SysCmd acSysCmdClearStatus
Set wd = Nothing
Set cd = Nothing
Set wr = Nothing
End Sub

Начал делать форму в accdb(2007 - 2010), писал аналогично (оба кода копировал не глядя)

Код


Public Sub Separate()   'Ðàçäåëåíèå äîêóìåíòà íà ñòðàíèöû
Dim app As Word.Application
Dim wd As Word.Document
Dim cd As Word.Document
Dim wr As Word.Range
Dim i As Long
Dim cnt As Long
Dim fn As String
Set app = CreateObject("Word.Application")
Set wd = app.Documents.Open(Forms![Form1].[Поле0].Value)
Set wr = wd.Range
i = 1
cnt = wd.Content.ComputeStatistics(wdStatisticPages)
SysCmd acSysCmdClearStatus
SysCmd acSysCmdInitMeter, "Разбивка страниц", cnt
   Do Until i > cnt
   SysCmd acSysCmdUpdateMeter, i
      If i = cnt Then
      wr.End = wd.Range.End
      Else
      Selection.Goto wdGoToPage, wdGoToAbsolute, i + 1
      wr.End = Selection.Start
      End If
   wr.Copy
   Set cd = Documents.Add
   cd.Range.Paste
   cd.Range.Find.Execute FindText:="^m", ReplaceWith:=""
   fn = Replace(wd.FullName, ".doc", "_" & i & ".doc")
   cd.SaveAs2 fn
   i = i + 1
   Me!Список3.AddItem Item:=fn
   cd.Close
   wr.Collapse wdCollapseEnd
   Loop
SysCmd acSysCmdClearStatus
Set wd = Nothing
Set cd = Nothing
Set wr = Nothing
End Sub

Когда пытаюсь запустить в accdb в строке

Код


 Selection.Goto wdGoToPage, wdGoToAbsolute, i + 1

Ошибка - Объектная переменная или переменная блока With не установлена.
Не могу понять из-за чего.

Слышал краем глаза, что на этом форуме есть некий Центр Помощи. Если с подобными вопросами туда, скиньте ссылку, самостоятельно не нашёл

Автор: Akina 14.8.2017, 15:34

Код - совершенно убийственный. Зачем Вы используете позднее связывание, если у Вас подключена объектная библиотека?

Суть наблюдаемой проблемы - в том, что не определено, что есть Selection. Замените его на объектную ссылку на обрабатываемый документ.

PS. И при публикации кода смотрите внимательнее, какой тип кода используете для обрамления тегом. Тег SQL-кода для VBA не очень подходит...

Автор: Ethex 14.8.2017, 17:40

Цитата(Akina @ 14.8.2017, 15:34

)

PS. И при публикации кода смотрите внимательнее, какой тип кода используете для обрамления тегом. Тег SQL-кода для VBA не очень подходит...

Хорошо
Помогло

Код


wd.ActiveWindow.Selection.Goto wdGoToPage, wdGoToAbsolute, i + 1
wr.End = wd.ActiveWindow.Selection.Start

Что же, помимо конкретно этой ошибки делает код совершенно убийственным? Если не секрет. Можно даже без перевода на чайниковский. Покумекаю на досуге, будет тяжко мне наверняка, но вдруг чего и выйдет.
И, всё же интересно, почему в поздней версии не сработало то, что сработало в ранней?...

Автор: Akina 15.8.2017, 07:56

Цитата(Ethex @ 14.8.2017, 18:40

)

Что же, помимо конкретно этой ошибки делает код совершенно убийственным? Если не секрет.

Я же вроде сказал... У Вас в коде есть

Код


Dim app As Word.Application
Dim wd As Word.Document
Dim cd As Word.Document
Dim wr As Word.Range

Значит, у Вас подключена в референсах Microsoft Word Object Library - иначе Вы бы получили ошибку вроде "неизвестный тип переменной".
Но если так - то гораздо разумнее вместо позднего связывания

Код


Set app = CreateObject("Word.Application")

использовать раннее

Код


Set app = New Word.Application

Дело в том, что при использовании раннего связывания в области данных программы формируются описанные в библиотеке структуры. Если окажется, что структуры в текущей версии библиотеки на рабочей станции иные - получите ошибку исполнения, причём крайне непросто диагностируемую, тогда как в показанном варианте сразу получите сообщение о том, что библиотека не найдена.

Если же Вы хотите, наоборот, получить по возможности универсальный (с точки зрения версии библиотеки) код, то референс следует убрать. А чтобы при этом на время написания программы не потерять удобство использования Intellisence - удалите референс непосредственно перед сборкой проекта, а определения конкретных типов измените на абстрактное As Object.

Автор: Ethex 15.8.2017, 08:59

Лазал со своими кодами на разные форумы, ни разу не указали. Впрочем, и не обязаны были...
Спасибо вам за терпение. Со связыванием посильно ознакомлюсь