Прозрачные страницы MS Word

[a_zheshko]

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

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

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

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

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

[viter.alex]

Не понятно, при чём здесь SelectPage? Страницу выделить нужно?

[Aent]

Или PicPic (http://www.picpick.org/ ) или печать в графический файл.
Это умеют делать почти все современные виртуальные принтеры ...

[a_zheshko]

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

[a_zheshko]

Aent

Сообщение от Aent

Или PicPic (http://www.picpick.org/ ) или печать в графический файл. Это умеют делать почти все современные виртуальные принтеры ...

Я знаком с виртуальными принтерами. Сейчас проверить возможности этой проги не могу, гляну завтра...

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

Поскольку в рассматриваемом случае от документа ворд как бы послойно надо отделить текст и встроенное изображение и положить его на прозрачный фон. Врод, если я не ошибаюсь, не имеет возможности работать со слоями... Хотя, в наше время возможно почти всё

[a_zheshko]

Вчера попробовал для решения своей задачки данные из 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 --> 2 (PsNewRGB) задаем режим RGB
'3 = PsDocumentFill --> 3 (psTransparent) задаем прозрачную заливку фона

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

Set myTextLayer = mergedDoc.ArtLayers.Add
With myTextLayer
    .Name = "text"
    .Kind = 2 ' 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 appRef, docRef, myLayerSets(3, 3), textArray, i, myLayers(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")
'Создаем индексированную переменную
i = 0
' Создаем три слоя (каждый последующий поверх предыдущего)
For i = 0 To 2
Set myLayerSets(i, 0) = docRef.LayerSets.Add
Next
' Rearrange the layer sets with the first one on top, second next, etc.
myLayerSets(1, 0).MoveAfter (myLayerSets(0, 0))
myLayerSets(2, 0).MoveAfter (myLayerSets(1, 0))
' 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 i = 0 To 2
Set myLayers(i) = myLayerSets(i, 1).ArtLayers.Add
myLayers(i).Kind = 2 ' 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 


[a_zheshko]

Сегодня пытался воевать с векторной графикой. В качестве жертвы выбрал 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:=0, Bottom:=285, Text:=wordText)
shape1.Text.ConvertToParagraph
Rem shape1.Text.Frame.Fill.ApplyPatternFill.Canvas.Clear
shape1.WrapText = cdrWrapContourStraddle
shape1.Text.Story.Characters.First.Fill.UniformColor.RGBAssign 155, 0, 0

shape1.Text.Range(Start:=0, End:=shape1.Text.Story.Characters.Count).Alignment = cdrCenterAlignment
shape1.Text.Range(Start:=0, End:=shape1.Text.Story.Characters.Count).Size = "18"
shape1.Text.Range(Start:=0, End:=shape1.Text.Story.Characters.Count).Font = "Times New Roman"
shape1.Text.Range(Start:=0, End:=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 i = 1 To CorelDRAW.Application.Documents.Count
    CorelDRAW.Application.Documents(i).Close
Next i
CorelDRAW.Application.Quit

End Sub 


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

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

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