1

Тема: Помогите создать макрос.

Здравствуйте. Есть 300 сканов в формате .jpg, их нужно закинуть в ворд документ, при этом чтоб они растягивались и центрировались под страницу А4 автоматически.
Спасибо, с уважением.

2

Re: Помогите создать макрос.

Kutsolap пишет:

Здравствуйте. Есть 300 сканов в формате .jpg, их нужно закинуть в ворд документ, при этом чтоб они растягивались и центрировались под страницу А4 автоматически.
Спасибо, с уважением.

Sub GetAllPicsFromFolder()
Dim oFSO, oFolder As Object
Dim oDoc As Document
Dim sFolder, sName, sPathName As String
Dim iHeight, iWidth, iCounter As Integer
    Set oDoc = ActiveDocument
    iCounter = 0
    sFolder = "C:\Users\client606_15\Desktop\Pictures" 'Путь к папке
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(sFolder) Then
        Set oFolder = oFSO.GetFolder(sFolder)
        For Each oFile In oFolder.Files
        sName = oFile.Name
            'Можно указать свой формат рисунка
            If InStr(sName, ".jpg") >= 1 Or InStr(sName, ".png") >= 1 Then
                sPathName = sFolder & "\" & sName
                iHeight = Selection.PageSetup.PageHeight
                iWidth = Selection.PageSetup.PageWidth
                Application.Selection.Range.InlineShapes.AddPicture sPathName, LinkToFile:=False, SaveWithDocument:=True
                iCounter = iCounter + 1
                oDoc.InlineShapes(iCounter).Height = iHeight
                oDoc.InlineShapes(iCounter).Width = iWidth
                Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
            End If
        Next oFile
    End If
    MsgBox "Все файлы внесены"
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

3

Re: Помогите создать макрос.

Fck_This пишет:
. . .
                iHeight = Selection.PageSetup.PageHeight
                iWidth = Selection.PageSetup.PageWidth
. . . 
                oDoc.InlineShapes(iCounter).Height = iHeight
                oDoc.InlineShapes(iCounter).Width = iWidth
. . .

При таком подходе преобразованные картинки могут исказиться, напр., квадратные по исходным размерам картинки станут вытянутыми под формат A4. Это надо проверить. Если искажение возможно, а для пользователя это недопустимо, то можно было бы применить такой подход: попытаться увеличивать исходный размер в цикле, пока не будет превзойдена целевая высота или ширина (что-то произойдет раньше) -  тогда цикл закончить, а наработанные значения ширины и высоты присвоить рисунку. Эти вычисления не сильно затормозят макрос.

4

Re: Помогите создать макрос.

Можно растянуть по ширине и включить функцию сохранения соотношений. Про центрирование забыл. Хотя если подразумевается по ширине - то при изменении размеров под лист - они и так по центру будут

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871