Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.04.2011, 23:01   #1
a_zheshko
Пользователь
 
Аватар для a_zheshko
 
Регистрация: 08.04.2011
Сообщений: 15
Смущение Прозрачные страницы MS Word

Мне надо как-нибудь:

1) захватить текст с картинками из Worda да так, что бы область выделения на всех страницах была одинаковой. Типа того: Selection.Width = Selection.Heigth

2) Затем Selection конвертировать в какой-либо графический формат с прозначным фоном, например PNG.

3) Передать растровые фрагменты в графический редактор для последующей обработки.

Как последние два пункта захимичить я знаю, вот как первый реализовать? А? Покопался в объектой модели Worda и к моему удивлению не обнаружил там Метод SelectPage. Интересно, почему его нет и как мне быть?
Или может быть я не то делаю и есть такая волшебная кнопка в MS Word, нажав на которую можно сделать фон страниц прозначным, что бы тока были видны текст и объекты и сохранить это как картинку?.. Думаю, вряд ли)
Android & Linux

Последний раз редактировалось a_zheshko; 13.04.2011 в 23:05. Причина: Правка
a_zheshko вне форума Ответить с цитированием
Старый 14.04.2011, 00:28   #2
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Не понятно, при чём здесь SelectPage? Страницу выделить нужно?
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума Ответить с цитированием
Старый 14.04.2011, 00:51   #3
Aent
Форумчанин
 
Аватар для Aent
 
Регистрация: 17.07.2009
Сообщений: 519
По умолчанию

Или PicPic (http://www.picpick.org/ ) или печать в графический файл.
Это умеют делать почти все современные виртуальные принтеры ...
Aent вне форума Ответить с цитированием
Старый 14.04.2011, 02:34   #4
a_zheshko
Пользователь
 
Аватар для a_zheshko
 
Регистрация: 08.04.2011
Сообщений: 15
По умолчанию

viter.alex,
Цитата:
Не понятно, при чём здесь SelectPage? Страницу выделить нужно?
У меня в *.doc? картинки с описаловом, на каждой странице по изображению и описанию к нему. Надо с каждой страницы захватить одинаковую область (текст + изображение), на мой взгляд оптимальным вариантом бы было типа (код выдумываю, т.к. виндоус тока на работе, а дома Linux):
==========================
For i=1 To .Pages.Count
Pages(i).Select (Select должен быть для всех Pages одинаковый по Width и Hight)
Selection.Copy
PasteSpetial=как картинку
Selection.SaveAs = wdPng.....
Next i
Android & Linux
a_zheshko вне форума Ответить с цитированием
Старый 14.04.2011, 02:45   #5
a_zheshko
Пользователь
 
Аватар для a_zheshko
 
Регистрация: 08.04.2011
Сообщений: 15
По умолчанию

Aent

Цитата:
Сообщение от Aent Посмотреть сообщение
Или PicPic (http://www.picpick.org/ ) или печать в графический файл. Это умеют делать почти все современные виртуальные принтеры ...
Я знаком с виртуальными принтерами. Сейчас проверить возможности этой проги не могу, гляну завтра...

Но меня терзают сомнения, что то что я задумал, вряд ли осуществимо посредством виртуального принтера.

Поскольку в рассматриваемом случае от документа ворд как бы послойно надо отделить текст и встроенное изображение и положить его на прозрачный фон. Врод, если я не ошибаюсь, не имеет возможности работать со слоями... Хотя, в наше время возможно почти всё
Android & Linux
a_zheshko вне форума Ответить с цитированием
Старый 16.04.2011, 02:42   #6
a_zheshko
Пользователь
 
Аватар для a_zheshko
 
Регистрация: 08.04.2011
Сообщений: 15
По умолчанию

Вчера попробовал для решения своей задачки данные из MS Worda портировать в Adobe Photoshop. Для текста и рисунков еще куда бы ни шло, но вот с таблицами шоп напрочь отказывается работать. Можно тока как картинку таблицу к нему отправить. И еще фотошоп не очень дружен с бейсиком, и поуправлять его объектами, покопаться в их свойствах, получается лишь на самом примитивном уровне... Таким образом передать объекты из ворда для последующей обработки средствами растровой графики Photoshop ни к чему хорошему меня не привели...
PHP код:
Sub A_Zheshko_MSWord_TO_Photoshop()
Dim appRef
Dim myTextWord 
As String

myTextWord 
Documents(1).Paragraphs(1).Range.Text
MsgBox myTextWord
'создаем объект Photoshop
Set appRef = CreateObject("Photoshop.Application")
'
Закрываем все открытые документы Photoshop
Do While appRef.Documents.Count
appRef
.ActiveDocument.Close
Loop


' Устанавливаем в качестве едениц измерения пиксели
With appRef.Preferences
.RulerUnits = psPixels
.TypeUnits = psPixels
End With
appRef.DisplayDialogs = psDisplayNoDialogs '
запрещаем отображение стартового диалога


' Создаем документы 300 dpi (для печати) = 2480 X 3508 pixels (Это и есть формат "A4", т.е. "210mm X 297mm @ 300 dpi")

Set mergedDoc = appRef.Documents.Add(2480, 3508, 300, "Заголовок", 2, 3, 1)


'
нумерованые значения 2 PsNewDocumentMode --> (PsNewRGBзадаем режим RGB
'3 = PsDocumentFill --> 3 (psTransparent) задаем прозрачную заливку фона

Создаем три слоя (каждый последующий поверх предыдущего)

Set myTextLayer mergedDoc.ArtLayers.Add
With myTextLayer
    
.Name "text"
    
.Kind ' PsLayerKind.psTextLayer - Указываем, что это текстовый слой
    
 With TextItem
    
    .Contents = myTextWord
    .Size = 16
    .Hyphenation = True
    .Font = "Times New Roman"
    .HyphenateAfterFirst = 3
    .Position = Array(300, 300)
End With
End With

Set myImageLayer = mergedDoc.ArtLayers.Add
With myImageLayer
    .Name = "image"
    .Kind = 1 ' 
PsLayerKind.psTextLayer Указываемчто это текстовый слой
    ThisDocument
.InlineShapes(1).Select
    Selection
.Copy
    appRef
.ActiveDocument.Paste
End With

End Sub

Sub MyWord
()
ThisDocument.InlineShapes(1).Select
Selection
.Copy
End Sub

Sub PhoNew
()
Dim appRefdocRefmyLayerSets(33), textArrayimyLayers(3)
Set appRef CreateObject("Photoshop.Application")
'Закрываем все открытые документы Photoshop
Do While appRef.Documents.Count
appRef.ActiveDocument.Close
Loop
создаем рабочий документ

Set docRef 
appRef.Documents.Add
' Создаем массив для вставки текста
textArray = Array("First", "Second", "Third")
'
Создаем индексированную переменную
0
' Создаем три слоя (каждый последующий поверх предыдущего)
For i = 0 To 2
Set myLayerSets(i, 0) = docRef.LayerSets.Add
Next
Rearrange the layer sets with the first one on topsecond nextetc.
myLayerSets(10).MoveAfter (myLayerSets(00))
myLayerSets(20).MoveAfter (myLayerSets(10))
' Create a layer set inside each layer set
For i = 0 To 2
myLayerSets(i, 0).Name = textArray(i) + " Set"
Set myLayerSets(i, 1) = myLayerSets(i, 0).LayerSets.Add
myLayerSets(i, 1).Name = "Inside " + textArray(i) + " Set"
Next
Создаем текстовый слой с описанием
For 0 To 2
Set myLayers
(i) = myLayerSets(i1).ArtLayers.Add
myLayers
(i).Kind ' PsLayerKind.psTextLayer
myLayers(i).TextItem.Contents = "Layer in " & textArray(i) & " Set Inside " _
& textArray(i) & " Set"
myLayers(i).TextItem.Position = Array(appRef.ActiveDocument.Width * i * 0.33, _
appRef.ActiveDocument.Height * (i + 1) * 0.25)
myLayers(i).TextItem.Size = 12
Next
End Sub 
Android & Linux
a_zheshko вне форума Ответить с цитированием
Старый 16.04.2011, 02:54   #7
a_zheshko
Пользователь
 
Аватар для a_zheshko
 
Регистрация: 08.04.2011
Сообщений: 15
По умолчанию

Сегодня пытался воевать с векторной графикой. В качестве жертвы выбрал Corel Draw X5. Тут тоже без малой крови не обошлось. Вначале вроде все хорошо шло, и текст, и графика неплохо передавалась. Но потом к своему огорчению заметил, что после портирования из Worda изображений, Корел не позволяет редактировать встроенные в слои элементы.
Начал разбираться, что за фигня. Оказалось, что во вновь создаваемом документе Корела надо обязательно задавать режимы цвета, в которых предстоит работать, типа того:
Код:
ColorContext = CreateColorContext2("sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%")
. Дык вот, даже если задать этот режим, после вставки растрового изображения все отрубается, и снова не поддается редактированию. А как решить эту задачу, я сколько не гуглил, не нашел. Разработчики Корела, при всём моем уважении к ним, поленились в хелпе расписать особенности работы этим объектом, а ограничились лишь там, что просто привели его название, что мол есть такой. Короче вот код:

PHP код:
VERSION 1.0 CLASS
BEGIN
  MultiUse 
= -1  'True
END
Attribute VB_Name = "ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Sub WordToCorelDraw_AZheshko()
Dim ExportOptions As New CorelDRAW.StructExportOptions
Dim appCorel As CorelDRAW.Application
Dim docCorel As CorelDRAW.Document
Dim shape1 As CorelDRAW.Shape

'
Стартуем Corel Apps
Set appCorel 
CreateObject("CorelDRAW.Application.15")
appCorel.Visible True
   
   
    Dim createopt 
As StructCreateOptions
    Set createopt 
CreateStructCreateOptions
    
'В креаторе задаем основные параметры создаваемого документа
    With createopt
        .Name = "MsWord to CoredDraw"
        .Units = cdrMillimeter '
Задаем еденицы измерения для разметкри Corel Docs
        
.PageWidth 210#
        
.PageHeight 297#
        
.Resolution 300#
        
.ColorContext CreateColorContext2("sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%")
       
    
End With
    
'Создаем Corel Docs с параметрами, заданными в креаторе
    Set docCorel = CreateDocumentEx(createopt)
    docCorel.Activate
    appCorel.Windows(1).Top = True '
Эту строчку добавляемесли необходимо отобразить Corel поверх остальных окон
  
  
    
'===============================================================================
    '
Передача текста
   
'Переносим абзацы
Dim wordText As String
wordText = ThisDocument.Paragraphs(1).Range.Text
MsgBox wordText
'
Создаем текстовый слойпозицианируем его
Set shape1 
docCorel.Pages(1).Layers(1).CreateArtisticText(Left:=0Bottom:=285Text:=wordText)
shape1.Text.ConvertToParagraph
Rem shape1
.Text.Frame.Fill.ApplyPatternFill.Canvas.Clear
shape1
.WrapText cdrWrapContourStraddle
shape1
.Text.Story.Characters.First.Fill.UniformColor.RGBAssign 15500

shape1
.Text.Range(Start:=0End:=shape1.Text.Story.Characters.Count).Alignment cdrCenterAlignment
shape1
.Text.Range(Start:=0End:=shape1.Text.Story.Characters.Count).Size "18"
shape1.Text.Range(Start:=0End:=shape1.Text.Story.Characters.Count).Font "Times New Roman"
shape1.Text.Range(Start:=0End:=shape1.Text.Story.Characters.Count).Bold True
'Размеры текстового шейпа
shape1.SizeWidth = "192"
shape1.SizeHeight = "25"
shape1.AlignToPageCenter cdrAlignLeft + cdrAlignRight, cdrTextAlignBoundingBox
    
    
ThisDocument.InlineShapes(1).Select
Selection.Copy

docCorel.Pages(1).Layers(1).PasteSpecial ("Bitmap")
End Sub


Sub QuickClose()
'
Это что бы быстро закрыть корел

Dim ExportOptions 
As New CorelDRAW.StructExportOptions
Dim i 
As Integer
On Error Resume Next

For 1 To CorelDRAW.Application.Documents.Count
    CorelDRAW
.Application.Documents(i).Close
Next i
CorelDRAW
.Application.Quit

End Sub 
Потом я забил на всё, пошел покурил, и решил делать всё вручную. Конечно, что бы хоть как-то автоматизировать процесс кое-какие макросы использовал . Но уже написанные для Корела, а не из-под Word.

Вывод: угробил два дня, немного разобрался с объектной моделью Phothshop и Corel Draw но толку от этого - никакого. Потом за час собрал такой офигенный постер (для чего всё написанное выше и делалось) почти без всякого кода, что мой шеф точно останется довольным.

Это и есть подводные камни "автоматизации" ))) Нажал на кнопку - и вся спина мокрая))
Android & Linux

Последний раз редактировалось a_zheshko; 16.04.2011 в 03:05. Причина: Правка кода
a_zheshko вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Параметры страницы MS WORD kaa1977 Общие вопросы Delphi 6 23.11.2018 12:54
Разбить рабочий лист MS Word на 2 страницы Tayfun Общие вопросы Delphi 1 04.01.2010 18:26
Удаление пустой страницы Word Flame_of_Death Общие вопросы Delphi 1 16.07.2009 07:07
Цвет страницы и текста в Word 2003. Рубеж Microsoft Office Word 4 24.11.2008 10:06
Прозрачные компоненты SunKnight Общие вопросы Delphi 5 21.01.2008 19:29