Страницы: 1
RSS
Копирование таблицы из эксель в ворд через макрос
 
Добрый день! Написал следующий макрос для копирования таблицы из Эксель в Ворд, но проблема в том, что таблица не умещается в границы листа Ворда. Как можно уменьшить масштаб таблицы, что бы все колонки уместились? Помогите пожалуйста.
Код
Sub Макрос3()

Dim objWord As Object
Dim FileStart
Dim FileNew

'Set objWord = CreateObject("Word.Application")
adr = InputBox("Введите путь к папке с шаблоном")
adr2 = InputBox("Введите путь к папке куда сохранить документ")

FileSt = adr & "\Шаблон.rtf"

'Set objDoc = objWord.Documents.Open(FileSt)
'objWord.Visible = True


Set objWord = CreateObject("Word.Application")
FileNew = adr2 & "\Перовское_Чистинское.rtf"

Set objDoc = objWord.Documents.Open(FileSt)

objWord.Visible = True

Range(Cells(1, 1), Cells(13, 18)).Copy

objDoc.Bookmarks("Закладка").Range.Paste

End Sub
 
Добавить что-то вроде
Код
objDoc.Tables(1).AutoFitBehavior (2)
Соблюдение правил форума не освобождает от модераторского произвола
 
buchlotnik, Что то не получается, я так понимаю, что при копировании таблицы из Экселя в Ворд в Ворде не происходит автоматически преобразование ее в объект Tables, то есть нужно как то ее переконвертировать, но пока не получается.
 
Странно,  вот пример, который у меня нормально работает:
Код
Sub word()
    [A1:Q25].Copy
    With CreateObject("Word.Application")
        .Documents.Add
        .Visible = True
        .Activate
        .Selection.Paste
        .Selection.Tables(1).AutoFitBehavior (2)
    End With
End Sub
Соблюдение правил форума не освобождает от модераторского произвола
 
buchlotnik, вся я понял в чем была проблема, оказывается этот метод работает только на файлах docx, а у меня изначально был rtf. Спасибо за помощь!

Переписал макрос таким образом:
Код
Sub Макрос3()
Dim objWord As Object
Dim FileStart
Dim FileNew

'Set objWord = CreateObject("Word.Application")
adr = InputBox("Введите путь к папке с шаблоном")
adr2 = InputBox("Введите путь к папке куда сохранить документ")

FileSt = adr & "\Шаблон.docx"

'Set objDoc = objWord.Documents.Open(FileSt)
'objWord.Visible = True


Set objWord = CreateObject("Word.Application")
FileNew = adr2 & "\Перовское_Чистинское.docx"

Set objDoc = objWord.Documents.Open(FileSt)

objWord.Visible = True

Range(Cells(1, 1), Cells(13, 18)).Copy

objDoc.Bookmarks("Закладка").Range.Paste

objDoc.Tables(1).AutoFitBehavior (2)
End Sub
Изменено: DopplerEffect - 19.06.2019 10:17:01
Страницы: 1
Наверх