Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование, преобразование данных и копирование в Word - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование, преобразование данных и копирование в Word (Макросы/Sub)
Копирование, преобразование данных и копирование в Word
nmaximov69 Дата: Суббота, 01.07.2017, 01:31 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Добрый день!
Прошу о помощи.
Есть таблица, у которой надо копировать заголовок и следующую строчку. Затем перевернуть таблицу, отформатировать ее под лист А4 и вставить в Word с сохранением.
И так несколько тысяч строк.
Вот такой вот составил макрос из разных источников, но на строчке Range("A1:K2").Select выдает 1004 ошибку.
И не получилось в word сохранить файл.
Можно было бы попросить уважаемых специалистов посмотреть и указать ошибки.
Был бы очень признателен!
Спасибо!
[spoiler]
[vba]
Код

Sub proga()
    Dim i As Long
    Dim objUsedRange As Range
    Set objUsedRange = ThisWorkbook.ActiveSheet.UsedRange
        For i = 2 To objUsedRange.Rows.Count
        With Application.Workbooks.Add
            Union(objUsedRange.Rows(1), objUsedRange.Rows(i)).Copy .ActiveSheet.Cells(1, 1)
     Range("A1:K2").Select
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-1
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "????????"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "???????"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1:A2").Select
    ActiveWindow.SmallScroll ToRight:=11
    Range("A1:K2").Select
    Selection.ClearContents
    Selection.EntireRow.Delete
    Range("N6").Select
        End With
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
AppWord.Documents.Add
ActiveSheet.PageSetup.PrintArea = "$A$1:$B$11"
Columns("A:B").ColumnWidth = 47
Range("A1:B11").Copy
AppWord.Selection.Paste
Application.CutCopyMode = False
Set AppWord = Nothing
    Next
End Sub
[/vba]
К сообщению приложен файл: 0224754.xlsx(13Kb)
 
Ответить
СообщениеДобрый день!
Прошу о помощи.
Есть таблица, у которой надо копировать заголовок и следующую строчку. Затем перевернуть таблицу, отформатировать ее под лист А4 и вставить в Word с сохранением.
И так несколько тысяч строк.
Вот такой вот составил макрос из разных источников, но на строчке Range("A1:K2").Select выдает 1004 ошибку.
И не получилось в word сохранить файл.
Можно было бы попросить уважаемых специалистов посмотреть и указать ошибки.
Был бы очень признателен!
Спасибо!
[spoiler]
[vba]
Код

Sub proga()
    Dim i As Long
    Dim objUsedRange As Range
    Set objUsedRange = ThisWorkbook.ActiveSheet.UsedRange
        For i = 2 To objUsedRange.Rows.Count
        With Application.Workbooks.Add
            Union(objUsedRange.Rows(1), objUsedRange.Rows(i)).Copy .ActiveSheet.Cells(1, 1)
     Range("A1:K2").Select
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-1
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "????????"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "???????"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1:A2").Select
    ActiveWindow.SmallScroll ToRight:=11
    Range("A1:K2").Select
    Selection.ClearContents
    Selection.EntireRow.Delete
    Range("N6").Select
        End With
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
AppWord.Documents.Add
ActiveSheet.PageSetup.PrintArea = "$A$1:$B$11"
Columns("A:B").ColumnWidth = 47
Range("A1:B11").Copy
AppWord.Selection.Paste
Application.CutCopyMode = False
Set AppWord = Nothing
    Next
End Sub
[/vba]

Автор - nmaximov69
Дата добавления - 01.07.2017 в 01:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование, преобразование данных и копирование в Word (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!