Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Office Новый топик    Ответить
 Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
Коллеги!

Не думал, что работа с VBA в Word настолько гиморна в сравнении с Excel.
Раньше никогда не писал макросы для Word, вот тут приспичило)
Помогите плиз.

Условие задачи:
1. пользователь загружает в Word-документ фотографии (обычно их много - более 5 шт)
2. после загрузки пользователь хочет запустить макрос, который
-- меняет размеры фотографий так, чтобы они сформировали "табличку" по 2 фотки в строке

второй тень играю с этими InlineShapes и Shapes, а счастья нет.
да еще и запись макросов в Word не так хорошо работает как в Excel.

Коллеги! Помогите расставить 5 фоток на листе в виде матрицы (по 2 фотки в строке)

П.С.

Пока не буду думать, как мне отслеживать еще переброс фоток на новые страницы.
Начнем просто с расстановки картинок в любое место листа.

П.П.С.
Кстати, почему проперти Shape.Left, Shape.Top, Shape.Width, Shape.Heignt показываются то в point то inches.
10 апр 19, 11:19    [21858090]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
Казанский
Member

Откуда:
Сообщений: 1307
RegisteredUser,
пробуйте. Предполагается, что картинки вставлены подряд как InlineShapes, т.е. Вставка - Рисунок - выделено несколько - Вставить, ну или по одному, но без пробелов.
Sub Re()
Dim i&, p As InlineShape, q As InlineShape, w#, k#
'ширина печатного поля
  With Selection.Sections(1).PageSetup
    w = .PageWidth - .LeftMargin - .RightMargin - .Gutter
  End With
'ширина текущего абзаца
  With Selection.Paragraphs(1)
    w = w - .LeftIndent - .RightIndent
  End With
  
  i = ActiveDocument.InlineShapes.Count
  For i = 1 To i - (i And 1) Step 2
    Set p = ActiveDocument.InlineShapes(i)
    Set q = ActiveDocument.InlineShapes(i + 1)
    p.LockAspectRatio = msoTrue
    q.LockAspectRatio = msoTrue
    k = w / (p.Width + q.Width) * 0.95 'подберите коэф. увеличения
    p.Width = p.Width * k
    q.Width = q.Width * k
  Next
End Sub
10 апр 19, 13:03    [21858216]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
ПЕНСИОНЕРКА
Member

Откуда: Владимирская обл
Сообщений: 4483
RegisteredUser
5 фоток на листе в виде матрицы (по 2 фотки в строке)

а 5-ю куда

ф1ф2
ф3ф4
ф5


inlineShapes --вставляете в табличку, заранее созданную, сама перенесет на следующий лист
хотя самой вставлять не приходилось, только считывала
10 апр 19, 13:08    [21858226]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
ПЕНСИОНЕРКА
RegisteredUser
5 фоток на листе в виде матрицы (по 2 фотки в строке)

а 5-ю куда

ф1ф2
ф3ф4
ф5


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


вот эту идею я сейчас и рассматриваю как самую лучшую.
НО
столкнулся с проблемой Cut/Paste картинки в определенную ячейку таблицы

П.С.
Вы как раз все правильно показали: 5 фоток - это 3 строки
10 апр 19, 13:48    [21858283]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
Коллеги!

Подскажите как работать с таблицей в Word.

1. я создал программно таблицу, но в документе могут быть иные таблицы.
Как мне точно знать, что я буду работать именно с моей таблицей?

2. я решил делать Picture.Cut и вставлять () эту картинку в ячейку моей таблицы
типа так Table1.Cell(iRow, iCol).Range.Paste

НО картинка не вставляется в ячейку
10 апр 19, 14:00    [21858300]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
Казанский
RegisteredUser,
пробуйте. Предполагается, что картинки вставлены подряд как InlineShapes, т.е. Вставка - Рисунок - выделено несколько - Вставить, ну или по одному, но без пробелов.
Sub Re()
Dim i&, p As InlineShape, q As InlineShape, w#, k#
'ширина печатного поля
  With Selection.Sections(1).PageSetup
    w = .PageWidth - .LeftMargin - .RightMargin - .Gutter
  End With
'ширина текущего абзаца
  With Selection.Paragraphs(1)
    w = w - .LeftIndent - .RightIndent
  End With
  
  i = ActiveDocument.InlineShapes.Count
  For i = 1 To i - (i And 1) Step 2
    Set p = ActiveDocument.InlineShapes(i)
    Set q = ActiveDocument.InlineShapes(i + 1)
    p.LockAspectRatio = msoTrue
    q.LockAspectRatio = msoTrue
    k = w / (p.Width + q.Width) * 0.95 'подберите коэф. увеличения
    p.Width = p.Width * k
    q.Width = q.Width * k
  Next
End Sub


Спасибо! я запустил Ваш пример.
Он меняете размер картинок прекрасно, НО не расставляет их в матрицу.
Картинки остаются InlineShapes, а их никак нельзя двигать по листу.
10 апр 19, 14:03    [21858303]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
Сделал!
Как по мне это не очень красиво, но пока другого решения не нашел.
Буду благодарен за дельные мысли.
Мне не нравится то, что приходится выгружать InlineShapes в файлы а потом их подымать в таблицу.
Хотел сделать Cut/Paste, но не получилось

итак, нужны 2 процедурки
1. сгребает все InlineShapes в файлы в темповый фолдер
2. подымает все фотки из темпового фолдера и вставляет в таблицу

Function WriteInlineShapesToFile(Optional IsRemoveImgFromDoc As Boolean = True) As Variant
    Dim arrPath()  As String
    Dim docCurrent As Document
    Dim shapeCurrent As InlineShape
    Dim RC As Integer
    Dim vData() As Byte
    Dim i As Long
    Dim lWritePos As Long
    Dim strOutFileName As String
    Dim tempFolder As String

    tempFolder = Environ("Temp") & "\"

    Set docCurrent = ActiveDocument

    i = 1

    For Each shapeCurrent In docCurrent.InlineShapes
        strOutFileName = tempFolder & "img" & CStr(i) & ".emf"
        Open strOutFileName For Binary Access Write As #1
        ReDim Preserve arrPath(i - 1)
        arrPath(i - 1) = strOutFileName
        i = i + 1
        vData = shapeCurrent.Range.EnhMetaFileBits
        lWritePos = 1

        Put #1, lWritePos, vData

        Close #1
        
        If (IsRemoveImgFromDoc) Then
            shapeCurrent.Delete
        End If

 Next shapeCurrent

    'RC = MsgBox("Job complete.", vbOKOnly, "Job Status")
    WriteInlineShapesToFile = arrPath()
End Function


основной макрос и запуск (параметр указывает сколько должно быть колонок) в таблице

Sub ArrangeInlineShapes(Optional ByVal cntCol As Integer = 2)
Dim curInShp As InlineShape
Dim curShp As Shape
Dim Table1 As Table

Dim curPage As Long, curTableIndex As Long
Dim iRow As Long, iCol As Long
Dim iteration As Long
Dim curTableRange As Range, rgCell As Range
Dim rgBuf As Range

Dim maxCountImg As Long

Dim arrImgPaths()  As String

If (ActiveDocument.InlineShapes.Count > 0) Then

' select 1st InlineShapes in Document
    Set curInShp = ActiveDocument.InlineShapes(1)
        'curInShp.Range.Select
        
' insert Paragraf after 1st 1st InlineShapes
    Set curTableRange = curInShp.Range
    With curTableRange
        .Collapse (WdCollapseDirection.wdCollapseEnd)
        .Move WdUnits.wdCharacter, 1
        .Select
        .InsertParagraph
        '.InsertBreak (WdBreakType.wdPageBreak)
    End With

' detect PageNumber where 1st InlineShapes in Document
    'curPage = curTableRange.Information(wdActiveEndAdjustedPageNumber)

    arrImgPaths = WriteInlineShapesToFile(True)
    maxCountImg = UBound(arrImgPaths)
    
    Set Table1 = ThisDocument.Tables.Add(curTableRange, Round((maxCountImg + 1) / cntCol, 0), cntCol)

    If (maxCountImg > 0) Then
        iRow = 1: iCol = 1: iteration = 1
        For i = 0 To maxCountImg
            Set rgCell = Table1.Cell(iRow, iCol).Range
            ActiveDocument.InlineShapes.AddPicture arrImgPaths(i), Range:=rgCell
            iteration = iteration + 1
            iCol = iCol + 1
            If (iCol > cntCol) Then
                iCol = 1
                iRow = iRow + 1
            End If
            
            On Error Resume Next
            Kill arrImgPaths(i)
        Next i
    End If
    
End If


End Sub


Sub Start()
    ArrangeInlineShapes (3)
End Sub



не скажу что оптимально и быстро, но работает.
конструктивная критика приветствуется
10 апр 19, 16:29    [21858566]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
RegisteredUser
Member

Откуда:
Сообщений: 503
вот так выглядит результат

К сообщению приложен файл. Размер - 69Kb
10 апр 19, 16:30    [21858571]     Ответить | Цитировать Сообщить модератору
 Re: Как расставить фотографии на странице Word?  [new]
Казанский
Member

Откуда:
Сообщений: 1307
RegisteredUser
Он меняете размер картинок прекрасно, НО не расставляет их в матрицу
Он ставит по две картинки в строке, что Вы и хотели (см. приложение).

RegisteredUser
Мне не нравится то, что приходится выгружать InlineShapes в файлы а потом их подымать в таблицу
Жуть Картинка с другого сайта. Используйте метод InlineShape.ConvertToShape.

Вообще, лучше сначала пакетно обработать картинки в граф. редакторе, а потом вставлять в Word. Файл легче будет.

К сообщению приложен файл. Размер - 101Kb
11 апр 19, 09:18    [21858947]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Office Ответить