Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Можно ли определить, какие в документе используются шрифты, соответствующие области? А также используемые размеры шрифтов.
Хотя бы получить список используемых именно в данном документе шрифтов. Области можно найти поиском.
макет макроса
--
реальные возможности больше
и ускорить можно
----------
не поняла --насчет областей
макет макроса
--
реальные возможности больше
и ускорить можно
----------
не поняла --насчет областей
shanemac51, к сожалению, ваш заархивированный файл поврежден, и архив не раскрывается.
второй раз на этом форуме зипы не читаются
----
больше нигде с этим не встречалась
word 2007 c макросами
Sub st130416_0942c()
Dim c1, ss, s1, j1
Dim doc As Document
Set doc = Word.Documents(1)
Debug.Print doc.Name, doc.Characters.Count
j1 = 0
ss = ""
For Each c1 In doc.Characters
j1 = j1 + 1
s1 = Chr(13) & Chr(10) & c1.Font.Name & Chr(9) & c1.Font.Size
If InStr(ss, s1) = 0 Then
Debug.Print c1.Font.Name, c1.Font.Size, j1
ss = ss & s1
End If
Next c1
Debug.Print Now
debug.print ss
MsgBox ss
End SubБольшое спасибо. Отлично работает макрос!
Напомните, пожалуйста, для чего у вас расставлены операторы:
Debug.Print ...и почему они у меня ничего не выводят на экран?
Давно этим интересовался. 
Debug.Print выводит в отладочное окно
msgbox --на экран(небольшой объем)
если объем большой --обычно выводят в новый пустой документ
----
можно доработать под ваши условия
это только макет --проверка возможности реализации
Debug.Print выводит в отладочное окно
Это окно называется Immediate?
Большое спасибо!
доработала немного макрос
Sub st130416_0942c()
Dim c1, ss, s1, j1
Dim doc As Document
Set doc = Word.Documents(1)
Debug.Print doc.Name, doc.Characters.Count
j1 = 0
ss = "СПИСОК ИСПОЛЬЗОВАННЫХ ШРИФТОВ"
For Each c1 In doc.Characters
j1 = j1 + 1
s1 = Chr(13) & Chr(10) & c1.Font.Name & Chr(9) & c1.Font.Size
If InStr(ss, s1) = 0 Then
Debug.Print c1.Font.Name, c1.Font.Size, j1
ss = ss & s1
End If
Next c1
Debug.Print Now
'MsgBox ss
Word.Documents.Add
Selection.Range.Text = ss
End SubКруть )) Хотя мне не очень понятно пока... Поясните код? Области я имел в виду Range с какой по какой используется данный шрифт...
Круть )) Хотя мне не очень понятно пока... Поясните код?
Постараюсь расписать поподробнее. Если что, коллега меня поправит:
Sub st130416_0942c()
Dim c1, ss, s1, j1
Dim doc As Document
Set doc = Word.Documents(1)
' Установка текущего документа. Наверно, можно было вместо
' этого использовать объект ActiveDocument
Debug.Print doc.Name, doc.Characters.Count
' Вспомогательный оператор: выводит имя документа и количество знаков
' в отладочном окне
' Ввод исходных данных:
j1 = 0
ss = "СПИСОК ИСПОЛЬЗОВАННЫХ ШРИФТОВ"
' В строковой переменной ss собирается список всех использованных шрифтов
' и их размер
' Начало цикла. Просматриваются все знаки.
For Each c1 In doc.Characters
j1 = j1 + 1
' Счетчик цикла
s1 = Chr(13) & Chr(10) & c1.Font.Name & Chr(9) & c1.Font.Size
' Формируется строка для вывода: название и размер шрифта
' Chr(13) & Chr(10) – переход на следующую строку
' Условие отбора IF: Если данный шрифт и размер отсутствуют в списке ss,
' то их добавляют в данный список
If InStr(ss, s1) = 0 Then
Debug.Print c1.Font.Name, c1.Font.Size, j1
' Вспомогательный оператор: в отладочное окно выводятся наименование
' шрифта и его размер, добавляемые в список
ss = ss & s1
' Добавление наименования шрифта и его размера в список
End If
' Окончание условия IF
' Окончание итерации цикла, переход к следующему символу, если он имеется
Next c1
Debug.Print Now
' Вспомогательный оператор: в отладочное окно выводятся текущие
' дата и время
'MsgBox ss
' Этот оператор не выполняется
' В новом окне открывается новый документ:
Word.Documents.Add
' В новый документ выводится список шрифтов и размеры:
Selection.Range.Text = ss
End SubОбласти я имел в виду Range с какой по какой используется данный шрифт...
Аналогом областей в Word наверно являются разделы.
Вот макрос, который выводит на экран количество разделов в документе:
Sub CountSection()
Dim ss As String
ss = "Количество разделов в документе: " & ActiveDocument.Sections.Count
MsgBox ss
End SubSet doc = Word.Documents(1)
' Установка текущего документа. Наверно, можно было вместо
' этого использовать объект ActiveDocumentэто для случая, когда нет прав для записи в normal.dot
--открыть свой документ с макросами
--открыть исследуемый файл, он будет с номером 1
--можно доработать вызов, для анализа шрифтов всего каталога
Set doc = Word.Documents(1) ' Установка текущего документа. Наверно, можно было вместо ' этого использовать объект ActiveDocumentэто для случая, когда нет прав для записи в normal.dot
--открыть свой документ с макросами
--открыть исследуемый файл, он будет с номером 1
--можно доработать вызов, для анализа шрифтов всего каталога
shanemac51, уточните, пожалуйста:
- Мы открываем свой файл с макросами.
- Затем открываем исследуемый файл.
Правильно ли я понимаю, что он становится активным (и потому имеет номер 1)?
Каким же образом нам удастся обратиться к макросу из файла с макросами, если у нас не будет нет прав для доступа в normal.dot?
Разве макрос будет виден из исследуемого файла?
мы находимся в файле с макросами
исследуемый может быть открыт даже с скрытом виде(правда не пробовала)
просто мне хотелось проверить макрос в автономном режиме(вдруг что то не объявила)
---
нормаль у меня достаточно большой 500кб---видимо надо поделить его по этому принципу и-- вынести обработки документов из нормал
мы находимся в файле с макросами исследуемый может быть открыт даже с скрытом виде(правда не пробовала)
Мне непонятно: если мы находимся в файле с макросами, то почему исследуемый файл имеет номер 1. Какой же номер тогда имеет файл с макросами?
Нашел в интернете программку для просмотра открытых документов и их номеров:
Sub OpenDocuments()
OpenDocuments_Word = Documents.Count
For i = 1 To Documents.Count
MsgBox (Documents.Item(i).Name & " - документ номер " & i)
Next
End SubПорядок нумерации открытых документов пока не очень понятен. Может быть, по очередности открытия?
Если - по порядку открытия, то исследуемый файл должен был бы иметь номер 2:
--открыть свой документ с макросами
--открыть исследуемый файл
можно вставить проверку на имя
Sub st130416_0942c()
Dim c1, ss, s1, j1
Dim doc As Document, kdoc
If Word.Documents(1).Name = "Форма поиска.docm" Then
kdoc = 2
Else
kdoc = 1
End If
Set doc = Word.Documents(kdoc)
Debug.Print doc.Name, doc.Characters.Count
Debug.Print 1, doc.Name
j1 = 0
ss = "СПИСОК ИСПОЛЬЗОВАННЫХ ШРИФТОВ " & doc.Name
For Each c1 In doc.Characters
j1 = j1 + 1
s1 = Chr(13) & Chr(10) & c1.Font.Name & Chr(9) & c1.Font.Size
If InStr(ss, s1) = 0 Then
Debug.Print c1.Font.Name, c1.Font.Size, j1
ss = ss & s1
End If
Next c1
Debug.Print Now
'MsgBox ss
Word.Documents.Add
Selection.Range.Text = ss
End SubТолько хотел написать про названия файла, но опередили )). Да, с именем будет наверно надежнее. С номерами, по моему, работает некорректно (либо я написал некорректный код ). В итоге я просто закрывал и открывал нужные файлы по очереди. В принципе, работало при уже запущенном Word удовлетворительно быстро.
В общем, спасибо, алгоритм поиска шрифтов оказался довольно простым ). Просто нужно просмотреть шрифт каждого символа по очереди. Появилось что то новенькое, добавляем в строку. Что можете посоветовать по оптимизации?
Еще заметил глюк, у меня в одном документе якобы два шрифта. Один "Times New Roman", а другой "TimesNewRoman"! Интересно, с другими шрифтами может такое случится? Не то придется добавить "слипание" c1.Font.Name.
Range(3,24) - фрагмент с 3 по 24 символ.
...какие в документе...шрифты, соответствующие области....размеры...
Поделитесь, для чего это нужно?
Мысли:
- От перебора Character надо отказаться - очень медленно.
- Можно перебирать области, где один шрифт, с помощью команды Selection.SelectCurrentFont.
- Можно пройтись по стилям документа и считать шрифты оттуда, но это не всегда корректно.
- Кидать шрифты можно в Collection, отпадает кусок кода с проверкой дубликатов. Например: Col.Add Item:=Font, Key:=Font.Name
если размер шрифта параграфа=999999
---читать посимвольно
иначе
---размер шрифта--одинаков для параграфа
===========
надо попробовать --что дает разные шрифты в параграфе
shanemac51, так и сделал. Все работает, большое спасибо.
Ну и абзацы из непечатных символов просто пропустил.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться