» Word VBA

Всем привет!

Есть такая задачка.
Есть word в котором допустим есть только заголовки (уровни 1,2 и 3), текст, списки булетами и с нумерацией, и картинки.

Этот ворд надо перегнать в файл с простейшей html версткой (h1,h2,h3,i,b,li,img) и сохраненными картинками в png.

Можно ли как-нибудь решить такую задачку или возможно ее уже кто-то до меня решил?

Не работает. Я немного пишу в VBA Excel но Word, как софтину, никогда не понимал и не любил - у нас с ним это взаимно)
Вот и сейчас - с учетом подсказок, я не понимаю что надо сделать для решения этой примитивной задачи.
Если у кого будет минута соединить весь код - буду благодарен.

P.S. Цеплять пример не буду - там абракатабра в 5 слов, из которых два выделены жирным шрифтом. Засорение эфира только.
Спасибо.

Код: Private Sub CommandButton1_Click()

Dim lNumber As Long
Dim i As Long

'Помещаем в переменную lNumber, с какого номера
'должна начинаться нумерация бланков.
lNumber = Me.TextBox1.Value

'проверяем на согласие с условием
If CheckBox1.Value = False Then

'выводим сообщение
MsgBox "Ошибка!" & " " & "Необходимо принять условие."
Else

'Делаем столько витков цикла, сколько бланков необходимо вывести на печать.
For i = 1 To Me.TextBox2.Value Step 1

Dim oDoc As Document
Set oDoc = Application.Documents.Add("C:\Primer\BLANK.docm")

'Помещаем в закладку "bN_1" данные из переменной lNumber.
oDoc.Bookmarks("bN_1").Range.Text = lNumber + (i - 1)

'Помещаем в закладку "bN_2" данные из переменной lNumber.
oDoc.Bookmarks("bN_2").Range.Text = lNumber + (i - 1)

'Помещаем в закладку "bN_3" данные из переменной lNumber.
oDoc.Bookmarks("bN_3").Range.Text = lNumber + (i - 1)

'Помещаем в закладку "bN_4" данные из переменной lNumber.
oDoc.Bookmarks("bN_4").Range.Text = lNumber + (i - 1)

'Распечатываем.
Application.PrintOut Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=True, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0

'Скрываем пользовательскую форму
UserForm1.Hide

Next i
End If
End Sub

AKBA
1. передние нули отбросятся , если обязательно нужно чтобы были добавляйте "0"&Cstr(lNumber + (i - 1))
4. if isnumeric(TextBox1)=true then проверить на число
..left(TextBox1,1)="0" проверить первый ноль
len(TextBox1)=5 - длина

5. if TextBox2=1 or TextBox2=2 or TextBox2=50 then..

Black_Lung
спасибо, сейчас буду переваривать и пробовать =)

очень хотелось бы услышать комменты на тему пункта 3 особенно

Добавлено:
Black_Lung
по пункту 1 - вообще замечательно получилось, огромное-преогромное спасибо!!!
по пункту 4 - вопрос частично отпал, поскольку вы помогли с пунктом 1.
по пункту 5 - вот мне непонятно что писать после слова Then
если идти от обратно и написать If Not TextBox2=1, то это условие ещё проверится, а как сделать чтобы каждое из них проверялось на несоответствие? потому что мне надо просто сделать - при несовпадении - сообщение показывается.

Добавлено:
по пункту 5 - решил вопрос - поставил после выражения If Not скобки

Итак, оставшиеся вопросы:
1 - двусторонняя печать
2 - как правильно вставлять текст на место закладок, чтобы закладки при этом не удалялись?

как настроить двухсторонюю печать в vba
там очень много буков, проще создать отдельно дублирующий принтер с двухсторонней печатью поумолчанию и выбирать его с помощью ActivePrinter

Black_Lung
СПАСИБО
я уже находил эту статью MS, там действительно слишком много буковок =)
Последую вашему совету - настрою дубликат принтера скорее всего.

всем спасибо, решил все свои вопросы.

Все же не выходит у меня каменный цветок. Есть ли тут умельцы, которые осилят эту задачу?
Имеем - текст с выделенными фразами (форматирован как bold). Надо этот выделенный текст скопировать вниз документа и там создать из этого текста список. Как найти выделенный текст и сделать копи - я разобрался а как вставить это вниз и сделать список - тут не смог даже с подсказкой одного доброго форумчанина.
ниже файл и код.
(Скачать Doc2.docm с rapidshare.ru)

Спасибо.
[more]
Sub SubtractBoldTxt()

Dim s As Range
Dim doc As Document
Dim sHeader$
Dim iLen%

Set doc = Word.Documents("Doc2.docm")
sHeader = "Total"
iLen = Len(sHeader)

For Each s In doc.Sentences
If s.Words(1).Bold = True Then
x = s.Words(1).Bold
s.Font.ColorIndex = wdRed
s.Select

End If
Next
With Selection
.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior
.Copy
.EndKey (wdStory)
.Text = "Total" & vbCr
.EndKey (wdStory)
.PasteAndFormat (wdPasteDefault)
End With
End Sub
[/more]

[more] ol7ca

Вот код [more=модуля:]

Код: Sub SubtractBoldTxt()
Dim doc As Document
Dim s As Range
Dim iLen%
Dim bHdr As Boolean
Dim sHdr$

Set doc = ActiveDocument
sHdr = "Total"
iLen = Len(sHdr)

For Each s In doc.Sentences
If Left(s.Text, iLen) = sHdr Then Exit For
With s
If .Words(1).Bold = True Then
'x = .Words(1).Bold ' ???
.Font.ColorIndex = wdRed
.Select
.Copy
With Selection
If Not bHdr Then
bHdr = True
.EndKey (wdStory)
.Text = vbCr & vbCr & vbCr & vbCr
.MoveDown Unit:=wdLine
.MoveUp Unit:=wdLine
.Text = sHdr & vbCr & vbCr
End If
.EndKey (wdStory)
.Text = vbCr
.MoveUp Unit:=wdLine
.PasteAndFormat (wdPasteDefault)
.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior
End With
End If
End With
Next
End Sub

koyusi

Цитата:

ргхост

не сработал.

Всем доброго дня.
Прошу помощи у знатоков.

Есть файл с таблицами. Внутри числа выровнены с помощью табуляции "по разделителю". Нужно это для того, чтобы положительные и отрицательные (они пишутся в скобках) числа отображались друг под другом с висячей правой скобкой.

100
(100)

Этот файл существует в двух вариантах - английском и русском. Для того, чтобы выравнивание "по разделителю" работала правильно, английскую версию документа надо смотреть с английскими региональными параметрами, а русскую с русскими (то есть каждый раз лезть в Пуск - Панель управления - Язык и региональные стандарты и менять Анг на Рус, потом обратно).

Вопрос собственно в следующем:
можно ли в английский файл прописать макрос, который при открытии файла будет менять региональные параметры на английские, а при закрытии возвращать русские?

Буду благодарен за любые ссылки на матчасть.

manhattan_22
Поменять настройки просто:

Код: Option Explicit

Private Declare Sub SetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String)
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Const LOCALE_SDECIMAL As Long = &HE
Const LOCALE_STHOUSAND As Long = &HF

Public Sub SetDecimalFormat()
Dim lcid As Long
lcid = GetUserDefaultLCID()
SetLocaleInfoA lcid, LOCALE_SDECIMAL, ","
SetLocaleInfoA lcid, LOCALE_STHOUSAND, " "
End Sub

Салют! Ищу скрипт, чтоб случайным образом менял регистр в русскоязычном тексте. Коды символов верхних и нижних регистров отличаются на 32, кроме пары ёЁ - там разница 16. Как мне это видится - парсим текст в цикле, если код текущего символа в диапазоне 192-223 - прибавляем 32 случайным образом (если рандомное число меньше 0,5 - прибавляем, если больше - оставляем как есть), если 224-255 - вычитаем случайным образом, отдельно обрабатывается пара 184;168. Или может быть есть более совершенные методы.

crotoff
Парсить - это круто сказано про последовательный перебор. Да и сравнение с 0.5 - удачно выбрано :)

Я бы пошел другим путем. Сгенерил бы случайных целых в диапазоне от 1 до Len(sStr) случайным количеством от 0.4 до 0.6 этой Len(sStr). Если текст достаточно большой, то разбить его на разумные блоки sStr(i). После этого Mid справа проверять нужный символ на диапазон и соответственно этой проверке менять через синтаксис Mid слева. Если символ совсем не подходит, то просто пропустить. Как-то так...

jollyboy
а, догнал! символы выбираются случайным образом, и безусловная замена производится уже над выбранными

crotoff
Йез, йез! Пока писал расшифровку ты сам вкурил.

Ты идешь перебором ВСЕХ символов в строке и случ. обр. их меняешь. На достаточно большом тексте кол-во замен будет плясать вокруг 50%.

Я же пляшу от обратного. Определяюсь - сколько надо заменить ("случайным количеством от 0.4 до 0.6 этой Len(sStr)") и обрабатываю кол-во в два раза меньше.

crotoff
Если надо действительно случайно, то необходимо предусмотреть замену больших на малые (в начале предложений). Или перед началом сделать все мелкими.

crotoff
Gena1971

Цитата:

предусмотреть замену больших на малые (в начале предложений). Или перед началом сделать все мелкими.

Вот жирное действительно полезно - LCase весь текст. А UCase существенно упростит поверку диапазонов кодов.

Gena1971
коды "больших" лежат в другом диапазоне, впрочем как оно в Wordе я без понятия.
jollyboy
Что такое Mid, LCase, UCase?
Накидайте кстати годных функций - Длина строки, Текущий символ, Код символа и Символ кода, а если не лень, то и сам скрипт всё быстрее будет, чем в справочниках ковыряться

crotoff

Цитата:

коды "больших" лежат в другом диапазоне, впрочем как оно в Wordе я без понятия.

Не в том дело. Если действительно случайно, то надо чтоб и в начале предложения случайно выпадала либо большая либо малая. А так там гарантированно остается большая буква.
Впрочем все это от исходного текста зависит. Какой он, и что нужно получить в результате. Я сне представляю для чего это все нужно.

Gena1971
всё верно, в начале и в любом месте - либо большая либо малая. То же самое если встретится имя собственное или аббревиатура. В Excel VBA регистр можно через коды символов поменять (прибавить или отнять 32), а как в Word'е - без понятия. Cюда обратился потому что текст. А нужно это для того, чтобы текст можно было прочитать, но не так быстро, как обычно (пробежав глазами)

crotoff
Без "Ё"

Код:
Public Sub Test()
Dim i As Long, sChar As String
Dim pChars As Characters
Set pChars = ThisDocument.Range.Characters
Math.Randomize
For i = 1 To pChars.Count
sChar = LCase$(pChars(i).Text)
If (Asc(sChar) > 223) And (Asc(sChar) < 256) Then
If Math.Rnd >= 0.5 Then
pChars(i).Text = sChar
Else
pChars(i).Text = UCase$(pChars(i).Text)
End If
End If
Next i
Stop
End Sub

AndVGri
благодарю, только что проверил - работает, но в 2003. В 2010 не хочет, подсвечивает жёлтым Stop, а если Stop удалить - идёт сразу на End Sub
А, в 2003м тоже останавливается на Stop и подсвечивает жёлтым, но регистры меняет
Разобрался, это в 2010 настройки безопасности жёсткие стояли, удалил stop - и теперь всё работает.

crotoff
Цитата:

коды "больших" лежат в другом диапазоне, впрочем как оно в Wordе я без понятия.

Цитата:

В Excel VBA регистр можно через коды символов поменять (прибавить или отнять 32), а как в Word'е - без понятия.

VBA он и в Африке VBA.
F2

Цитата:

Есть такая задачка.
Есть word в котором допустим есть только заголовки (уровни 1,2 и 3), текст, списки булетами и с нумерацией, и картинки.
 
Этот ворд надо перегнать в файл с простейшей html версткой (h1,h2,h3,i,b,li,img) и сохраненными картинками в png.
 
Можно ли как-нибудь решить такую задачку или возможно ее уже кто-то до меня решил?

Никто не знает ?

Добрый день, утро, вечер!
Очень нужна помощь.
Задача -- изменить форматирование во всех формулах (MS Equation 3.0) документа (документов много, формул тоже)
Поясню, кто не в курсе, необходимо открыть редактор формул, настроить форматирование в меню Стиль и Размер (это можно сделать один раз) и последовательно входить-выходить в каждую формулу
Часть задачи удалось реализовать, а именно найти формулу и открыть ее. Кроме того VBA позволяет переходить к следующей формуле, но выйти из последней формулы я не могу.
Кто сталкивался с задачей управления объектами Worda откликнитесь, пожалуйста.

Попутный вопрос: в какой ветке реестра или вообще где MS Equation 3.0 хранит настройки по умолчанию, а именно Шрифта, Стиля, Размера, Интервалов

Благодарен за любую информацию (примеры, ссылки, учебники и т.д.)

Здравствуйте. Подскажите, пожалуйста.
Нужен макрос, который бы искал определенное слово и подставлял на пример дату.
То есть
Составил: 20.11.2012
Макрос должен искать по всему открытому документу слово "составил" и вставлял рядом с ним "20.11.2012".
"Составил" и "20.11.2012" находятся в одной строке таблицы, но в соседних ячейках.

У меня есть база ACCESS - каталог книг (автор, название...) Как внести в главный список литературы Word записи из этой базы? Что-то типа экспорта из базы в формате XML из базы в папку "библиография"? - но там какой то код Word генерирует при внесении нового источника... Что-то я совсем не соображу как поступить. НЕЛП, ПЛИЗ, профану!!!

Доброго вечера. Помогите пожалуйста подправить скрипт. Записал его через Запись макроса:

Sub Zakladka()
ActiveWindow.View.ShowBookmarks = False
End Sub

Выключает или включает при замене False на True отображение закладок. Сделал две кнопки на отключение и включение закладок. А как сделать один макрос который бы при первом нажатии включал, а при следующем выключал закладки? Спасибо