Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.04.2019, 11:44   #1
BK-201
 
Регистрация: 12.04.2019
Сообщений: 6
Радость Хитроумный экспорт Excel->Excel через кнопку

Доброго времени суток, уважаемые форумчане!

В общем, встал вопрос автоматизации создания документа.
Есть большая табличка с кучей полей в Excel и есть 2 разных документа, которые создаются на основе данных из этой таблицы.
Процесс копировать-вставить уже изрядно подзамучил, а в программировании меня собака съела, понятное дело не нужно семи пядей во лбу, но в тоже время не охота изобретать велосипед

В общем, смысл такой:
Из таблицы Экселя, надо из одной строки перекинуть данные в два файла, при этом нужна кнопка "Сформировать", которая на основе выбранной пользователем строки в самой таблице по заранее готовым шаблонам Экселя сможет создать два файла с разными названиями (данные по названиям файлов будут в таблице) в двух разных папках, вставить из таблицы данные в шаблоны (в шаблонах места вставки этих данных разные, не на одной линии и т.д., но в целом всегда на первом, максимум на втором листе).

Кто может мне подсказать где найти такой велосипед? Я пробовал использовать запись Макроса, но очень многого не понимаю и буду очень благодарен если мне кто укажет, что да как сделать

Код:
Sub Макрос2()
'
' Макрос2 Макрос
'
 
'
    Windows("отчет.xlsx").Activate
    Range("A2311").Select
    Selection.Copy
    Windows("1.xlsx").Activate
    Range("AP32:AX33").Select
    ActiveSheet.Paste
    Windows("отчет.xlsx").Activate
    Range("B2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1.xlsx").Activate
    Range("AP32:AX33").Select
    ActiveSheet.Paste
    Windows("отчет.xlsx").Activate
    Range("F2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1.xlsx").Activate
    Range("AY32:BF33").Select
    ActiveSheet.Paste
    Windows("отчет.xlsx").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Range("J2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1.xlsx").Activate
    Range("D49:X49").Select
    ActiveSheet.Paste
    ActiveWindow.LargeScroll ToRight:=1
    Range("N2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("1.xlsx").Activate
    Range("AR49:BA49").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Windows("отчет.xlsx").Activate
End Sub
Вот так примерно выглядит копипаста в один из файлов.
Всем заранее спасибо за помощь!
BK-201 вне форума Ответить с цитированием
Старый 12.04.2019, 12:20   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Начните с малого
1: создать два файла с разными названиями (данные по названиям файлов будут в таблице) в двух разных папках

2: вставить из таблицы данные в шаблоны с п1
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 12.04.2019, 13:28   #3
BK-201
 
Регистрация: 12.04.2019
Сообщений: 6
По умолчанию

Я сделалъ
11 - первый формируемый из таблицы документ-шаблон
21 - второй формируемый из таблицы документ-шаблон
3 - таблица в Экселе
Код:
Sub Копипаста()
'
' Копипаста Макрос
'

'
    Range("B2311").Select
    Selection.Copy
    Windows("11").Activate
    Range("AR32:AX33").Select
    ActiveSheet.Paste
    Windows("3.xlsx").Activate
    Range("F2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("11").Activate
    Range("AY32:BF33").Select
    ActiveSheet.Paste
    Windows("3.xlsx").Activate
    Range("J2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("11").Activate
    Range("D49:X49").Select
    ActiveSheet.Paste
    Windows("3.xlsx").Activate
    Range("N2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("11").Activate
    Range("AR49:BA49").Select
    ActiveSheet.Paste
    Windows("21").Activate
    Windows("3.xlsx").Activate
    ActiveWindow.Zoom = 70
    ActiveWindow.SmallScroll ToRight:=-2
    ActiveWindow.Zoom = 55
    Range("A2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("C2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("C5:G5").Select
    ActiveSheet.Paste
    Windows("3.xlsx").Activate
    Range("D2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("C6:G6").Select
    ActiveSheet.Paste
    Windows("3.xlsx").Activate
    Range("E2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("A14").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("F2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("G2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("C14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("I2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("D14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("J2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("E14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("L2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("J14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("N2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("K14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("L2311").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("21").Activate
    Range("B18").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("B18").Select
    Windows("3.xlsx").Activate
    Selection.Copy
    Windows("21").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("3.xlsx").Activate
    Range("G2311").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "№ 74197/1"
    Windows("21").Activate
    Range("B20:K20").Select
    ActiveCell.FormulaR1C1 = "№ 74197/1"
    Windows("3.xlsx").Activate
    Range("E2311").Select
    ActiveCell.FormulaR1C1 = "4/8/2019"
    Windows("21").Activate
    Range("B20:K20").Select
    ActiveCell.FormulaR1C1 = _
        "№ 74197/1 08.04.2019, "
    Windows("3.xlsx").Activate
    Range("H2311").Select
    ActiveCell.FormulaR1C1 = "№б/н"
    Windows("21").Activate
    Range("B20:K20").Select
    ActiveCell.FormulaR1C1 = _
        "№ 74197/1 08.04.2019,№б/н "
    Windows("3.xlsx").Activate
    Range("E2311").Select
    ActiveCell.FormulaR1C1 = "4/8/2019"
    Windows("21").Activate
    Range("B20:K20").Select
    ActiveCell.FormulaR1C1 = _
        "№ 74197/1 08.04.2019,№б/н 08.04.2019"
    Windows("3.xlsx").Activate
End Sub
Что дальше?

Последний раз редактировалось BK-201; 12.04.2019 в 13:29. Причина: ашипка
BK-201 вне форума Ответить с цитированием
Старый 12.04.2019, 15:00   #4
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

кросс http://www.cyberforum.ru/ms-excel/thread2435424.html
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 12.04.2019, 16:11   #5
BK-201
 
Регистрация: 12.04.2019
Сообщений: 6
По умолчанию

В правилах при регистрации прямого запрета на это не видел, извините

Ну и как посоветовали на другом форуме:
Вот примерные примеры (масло масляное) того, что мне нужно
Вложения
Тип файла: xlsx таблица.xlsx (9.4 Кб, 14 просмотров)
Тип файла: xlsx 1.xlsx (8.1 Кб, 12 просмотров)
Тип файла: xlsx 2.xlsx (8.1 Кб, 10 просмотров)

Последний раз редактировалось BK-201; 12.04.2019 в 16:22.
BK-201 вне форума Ответить с цитированием
Старый 15.04.2019, 11:05   #6
peq
Форумчанин
 
Регистрация: 01.03.2009
Сообщений: 230
По умолчанию

1. макрос очень длинный. у него в теле лучше прописывать не ссылки на конкретные ячейки(будет добавлена строка/столбец - весь текст придется менять), а логику.
2. по файлам непонятно что куда откуда. сделайте корректный пример и опишите логику заполнения файлов "1" и "2" по файлу "таблица" - тогда будет предмет обсуждения..
peq вне форума Ответить с цитированием
Старый 15.04.2019, 12:05   #7
BK-201
 
Регистрация: 12.04.2019
Сообщений: 6
По умолчанию

Цитата:
Сообщение от peq Посмотреть сообщение
1. макрос очень длинный. у него в теле лучше прописывать не ссылки на конкретные ячейки(будет добавлена строка/столбец - весь текст придется менять), а логику.
2. по файлам непонятно что куда откуда. сделайте корректный пример и опишите логику заполнения файлов "1" и "2" по файлу "таблица" - тогда будет предмет обсуждения..
Спасибо за конструктив.
Макрос всего лишь записан, не написан вручную, отсюда он такой громоздкий.

Логика простая, в файл Таблица заносятся данные по строкам: № 1, № 2, даты и место (ячейка Откуда).
Из Таблицы путем выбора диапазона / нажатия кнопки / ввода значения в форму / etc. нужно автоматически создавать файлы 1 и 2, в которых будет соответственно перенесена информация из Таблицы, соответственно в файл "1" - ячейка с № 1, дата 2 и ячейка Откуда с учетом того, что ячейки будут всегда расположены именно как в файле "1"; в файл "2" - из Таблицы должны быть перенесены данные из всех ячеек Таблицы кроме ячейки №1, но не строкой, а в разных местах самого файла "2", при этом, опять же, ячейки будут всегда расположены именно как в файле "2".

После переноса данных нужно сохранить файлы с названиями исходя из данных Таблицы - в частности первый файл будет назван исходя из столбиков № 1 и дата 1, второй файл из столбиков № 2 и дата 1.

Еще раз на всякий случай прикладываю файлы
Вложения
Тип файла: xlsx 1.xlsx (8.1 Кб, 13 просмотров)
Тип файла: xlsx 2.xlsx (8.2 Кб, 13 просмотров)
Тип файла: xlsx таблица.xlsx (9.4 Кб, 13 просмотров)
BK-201 вне форума Ответить с цитированием
Старый 17.04.2019, 15:15   #8
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

используя 1 и 2 как шаблоны
Код:
Sub test()
    Dim wb As Object
    Application.ScreenUpdating = False
    Dim NewName As String
    NewName = ActiveSheet.Cells(ActiveCell.Row, "A").Value & ActiveSheet.Cells(ActiveCell.Row, "E").Value
    Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\1.xlsx")
    Application.DisplayAlerts = False
    wb.SaveAs NewName & "_.xlsx"
    Application.DisplayAlerts = True
    With wb.Sheets(1)
        .[A1] = ActiveSheet.Cells(ActiveCell.Row, "A")
        .[B3] = ActiveSheet.Cells(ActiveCell.Row, "D")
        .[C5] = ActiveSheet.Cells(ActiveCell.Row, "E")
    End With
    wb.Saved = True
    wb.Close SaveChanges:=True
    NewName = ActiveSheet.Cells(ActiveCell.Row, "A").Value & ActiveSheet.Cells(ActiveCell.Row, "E").Value
    Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\2.xlsx")
    Application.DisplayAlerts = False
    wb.SaveAs NewName & "_2.xlsx"
    Application.DisplayAlerts = True
    With wb.Sheets(1)
        .[A1] = ActiveSheet.Cells(ActiveCell.Row, "B")
        .[B2] = ActiveSheet.Cells(ActiveCell.Row, "C")
        .[B6] = ActiveSheet.Cells(ActiveCell.Row, "C")
        
        .[C3] = ActiveSheet.Cells(ActiveCell.Row, "D")
        .[D1] = ActiveSheet.Cells(ActiveCell.Row, "D")
        .[D4] = ActiveSheet.Cells(ActiveCell.Row, "E")
    End With
    wb.Saved = True
    wb.Close SaveChanges:=True
    Application.ScreenUpdating = True
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 17.04.2019, 16:51   #9
BK-201
 
Регистрация: 12.04.2019
Сообщений: 6
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
используя 1 и 2 как шаблоны
Здравствуйте! Извините, либо я делаю что-то не так, либо я что-то не совсем правильно объяснил, либо не работает
Вставляю макрос в файл "Таблица.xlsm", выбираю строку для формирования файлов 1 и 2, выполняю на клавишу F5, после этого создаются два файла, названия которых формируются из данных в таблице. Эта (последняя) часть работает безупречно, и все в принципе понятно, можно изменить для любых нужд.
Но не работает перенос данных из ячеек в файле Таблица, во внутрь файлов, которые формируются с новыми названиями.

Исходя из кода:
Макрос формирует рабочий диапазон от столбца А до столбца Е с названием NewName
Открывает файл 1.xlsx
Сохраняет книжку через команду SaveAs с названием исходя из NewName + "_.xlsx"
потом идет часть итерации With, при этом для обоих файлов, как я понял, она не работает.
Подскажите, как исправить эту проблему?
BK-201 вне форума Ответить с цитированием
Старый 17.04.2019, 21:00   #10
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от BK-201 Посмотреть сообщение
как я понял, она не работает.
и в самом деле, не работает.
пробуйте так
Код:
Sub test()
    Dim wb As Object
    Application.ScreenUpdating = False
    Dim NewName As String
    Dim ShThis As Worksheet
    Dim iThisRow As Integer
    Set ShThis = ActiveSheet
    iThisRow = ActiveCell.Row
    NewName = ShThis.Cells(iThisRow, "A").Value & ShThis.Cells(iThisRow, "E").Value
    If Trim$(NewName) <> vbNullString Then
        Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\1.xlsx")
        Application.DisplayAlerts = False
        wb.SaveAs NewName & "_.xlsx"
        Application.DisplayAlerts = True
        With wb.Sheets(1)
            .[A1] = ShThis.Cells(iThisRow, "A")
            .[B3] = ShThis.Cells(iThisRow, "D")
            .[C5] = ShThis.Cells(iThisRow, "E")
        End With
        wb.Close SaveChanges:=True
    End If
    NewName = ShThis.Cells(iThisRow, "A").Value & ShThis.Cells(iThisRow, "E").Value
    If Trim$(NewName) <> vbNullString Then
        Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\2.xlsx")
        Application.DisplayAlerts = False
        wb.SaveAs NewName & "_2.xlsx"
        Application.DisplayAlerts = True
        With wb.Sheets(1)
            .[A1] = ShThis.Cells(iThisRow, "B")
            .[B2] = ShThis.Cells(iThisRow, "C")
            .[B6] = ShThis.Cells(iThisRow, "C")
            
            .[C3] = ShThis.Cells(iThisRow, "D")
            .[D1] = ShThis.Cells(iThisRow, "D")
            .[D4] = ShThis.Cells(iThisRow, "E")
        End With
        wb.Close SaveChanges:=True
    End If
    Application.ScreenUpdating = True
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Измнение данных в EXCEL PP через макрос EXCEL Zhuzha Microsoft Office Excel 4 01.03.2018 18:34
вывести данные в новую книгу Excel из другой книги Excel через VBA Алла94 Microsoft Office Excel 0 08.10.2014 16:16
Экспорт в Excel из Delphi через SQL запрос betirsolt БД в Delphi 1 19.05.2013 18:11
Excel - экспорт выбранной ячейки из DBGrid в Excel. wymkent Помощь студентам 0 16.05.2012 02:10
Экспорт из Access в Excel, Экспорт из отчётов в таблицу Excel Kissedbythegod Microsoft Office Access 1 31.05.2008 22:15