Макрос создает файл в excel

Создание файлов Excel методами Workbooks.Add, Worksheet.Copy и текстовых файлов с помощью оператора Open и метода CreateTextFile из кода VBA Excel. Создание документов Word рассмотрено в отдельной статье.

Метод Workbooks.Add

Описание

Файлы Excel можно создавать из кода VBA с помощью метода Add объекта Workbooks.

Workbooks.Add – это метод, который создает и возвращает новую книгу Excel. Новая книга после создания становится активной.

Ссылку на новую книгу Excel, созданную методом Workbooks.Add, можно присвоить объектной переменной с помощью оператора Set или обращаться к ней, как к активной книге: ActiveWorkbook.

Синтаксис

Workbooks.Add (Template)

Template – параметр, который определяет, как создается новая книга.

Значение Template	Параметры новой книги
Отсутствует	Новая книга с количеством листов по умолчанию.
Полное имя существующего файла Excel	Новая книга с указанным файлом в качестве шаблона.
xlWBATChart	Новый файл с одним листом диаграммы.
xlWBATWorksheet	Новый файл с одним рабочим листом.

Примеры

Пример 1
Создание новой книги Excel с количеством листов по умолчанию и сохранение ее в папку, где расположен файл с кодом VBA:

Sub Primer1() ‘Создаем новую книгу Workbooks.Add ‘Сохраняем книгу в папку, где расположен файл с кодом ActiveWorkbook.SaveAs (ThisWorkbook.Path & «Моя новая книга.xlsx») ‘Закрываем файл ActiveWorkbook.Close End Sub

Файл «Моя новая книга.xlsx» понадобится для следующего примера.

Пример 2
Создание новой книги по файлу «Моя новая книга.xlsx» в качестве шаблона с присвоением ссылки на нее объектной переменной, сохранение нового файла с новым именем и добавление в него нового рабочего листа:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub Primer2() ‘Объявляем объектную переменную с ранней привязкой Dim MyWorkbook As Workbook ‘Создаем новую книгу по шаблону файла «Моя новая книга.xlsx» Set MyWorkbook = Workbooks.Add(ThisWorkbook.Path & «Моя новая книга.xlsx»)     With MyWorkbook         ‘Смотрим какое имя присвоено новому файлу по умолчанию         MsgBox .Name ‘»Моя новая книга1″         ‘Сохраняем книгу с новым именем         .SaveAs (ThisWorkbook.Path & «Моя самая новая книга.xlsx»)         ‘Смотрим новое имя файла         MsgBox .Name ‘»Моя самая новая книга»         ‘Добавляем в книгу новый лист с именем «Мой новый лист»         .Sheets.Add.Name = «Мой новый лист»         ‘Сохраняем файл         .Save     End With End Sub

Метод Worksheet.Copy

Описание

Если в коде VBA Excel применить метод Worksheet.Copy без указания параметра Before или After, будет создана новая книга с копируемым листом (листами). Новая книга станет активной.

Примеры

Пример 3
Создание новой книги с помощью копирования одного листа (в этом примере используется книга, созданная в первом примере):

Sub Primer3() ‘Если книга источник не открыта, ее нужно открыть Workbooks.Open (ThisWorkbook.Path & «Моя новая книга.xlsx») ‘Создаем новую книгу копированием одного листа Workbooks(«Моя новая книга.xlsx»).Worksheets(«Лист1»).Copy ‘Сохраняем новую книгу с именем «Еще одна книжица.xlsx» в папку, ‘где расположен файл с кодом ActiveWorkbook.SaveAs (ThisWorkbook.Path & «Еще одна книжица.xlsx») End Sub

Также, как и при создании нового файла Excel методом Workbooks.Add, при создании новой книги методом Worksheet.Copy, можно ссылку на нее присвоить объектной переменной.

Пример 4
Создание новой книги, в которую включены копии всех рабочих листов из файла с кодом VBA:

Sub Primer4() ThisWorkbook.Worksheets.Copy End Sub

Пример 5
Создание новой книги, в которую включены копии выбранных рабочих листов из файла с кодом VBA:

Sub Primer5() ThisWorkbook.Sheets(Array(«Лист1», «Лист3», «Лист7»)).Copy End Sub

Создание текстовых файлов

Оператор Open

При попытке открыть несуществующий текстовый файл с помощью оператора Open, такой файл будет создан. Новый файл будет создан при открытии его в любом режиме последовательного доступа, кроме Input (только для чтения).

Пример

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Sub Primer6() Dim ff As Integer, ws As Object ‘Получаем свободный номер для открываемого файла ff = FreeFile ‘Создаем новый текстовый файл путем открытия ‘несуществующего в режиме чтения и записи Open ThisWorkbook.Path & «Мой-новый-файл.txt» For Output As ff ‘Записываем в файл текст Write #ff, «Этот файл создан при его открытии оператором « & _ «Open по несуществующему адресу (полному имени).» ‘Закрываем файл Close ff ‘Открываем файл для просмотра Set ws = CreateObject(«WScript.Shell») ws.Run ThisWorkbook.Path & «Мой-новый-файл.txt» Set ws = Nothing End Sub

В имени текстового файла пробелы заменены дефисами (знаками минус), так как метод Run объекта Wscript.Shell не способен открывать файлы с именами, содержащими пробелы.

Рекомендую открывать файлы для просмотра методом ThisWorkbook.FollowHyperlink. Пример и преимущества этого метода в статье VBA Excel. Открыть файл другой программы.

Метод FileSystemObject.CreateTextFile

Для создания нового текстового файла из кода VBA Excel по указанному имени, можно использовать метод CreateTextFile объекта FileSystemObject.

Пример

Sub Primer7() Dim fso, fl, ws ‘Создаем новый экземпляр объекта FileSystemObject Set fso = CreateObject(«Scripting.FileSystemObject») ‘Присваиваем переменной fl новый объект TextStream, ‘связанный с созданным и открытым для записи файлом Set fl = fso.CreateTextFile(ThisWorkbook.Path & «Еще-один-текстовый-файл.txt») ‘Записываем в файл текст fl.Write («Этот текстовый файл создан методом CreateTextFile объекта FileSystemObject.») ‘Закрываем файл fl.Close ‘Открываем файл для просмотра Set ws = CreateObject(«WScript.Shell») ws.Run ThisWorkbook.Path & «Еще-один-текстовый-файл.txt» End Sub

Стоит отметить, что новый текстовый файл может быть создан и с помощью метода OpenTextFile объекта FileSystemObject при условии присвоения параметру create значения True.

На чтение 3 мин. Просмотров 11.1k.

Что делает макрос: Следующий макрос копирует диапазон ячеек из активного листа и вставляет данные в новую книгу.

Содержание

1. Код макроса
2. Как работает этот код
3. Как использовать

Код макроса

Sub SozdatFajl()
'Шаг 1 - копируем данные с листа
Sheets("Продажи").Range("B4:C15").Copy

'Шаг 2 - создаем новую книгу
Workbooks.Add

'Шаг 3 - вставляем данные
ActiveSheet.Paste Destination:=Range("A1")

'Шаг 4 - отключаем системные сообщения
Application.DisplayAlerts = False

'Шаг 5 - сохраняем по нужному адресу
ActiveWorkbook.SaveAs _
Filename:="C:ОтчетыПродажиМесяц.xlsx"

'Шаг 6 - включаем системные сообщения
Application.DisplayAlerts = True
End Sub

Как работает этот код

1. Копируем данные из ячеек B4:С15. Обратите внимание, что мы указываем полный адрес с именем листа и диапазона. Это позволит не допустить ошибки, если у Вас открыто несколько файлов Excel одновременно.
2. Используем метод Add объекта Workbook, чтобы создать новую рабочую книгу. Это тоже самое, если бы мы вручную нажали Файл➜Создать➜Новый документ
3. На этом этапе используется метод Paste, чтобы отправить данные, которые вы скопировали в ячейку А1 новой книги. Обратите внимание на то, что код ссылается на объект  ActiveSheet. При создании новой книги она тут же становится активной. Если быть точнее, то становится активный лист в новой (только что созданной) книге.
4. Далее используем метод DisplayAlerts. Используя свойство False — отключаем системные предупреждения Excel. Можно этого не делать, но мы можем запустить этот макрос несколько раз, и в этом случае Excel будет пытаться сохранить один и тот же файл несколько раз. Что происходит, когда вы пытаетесь сохранить книгу несколько раз? Правильно — Excel предупреждает, что в папке уже есть файл с таким же именем и спрашивает: «Хотите ли вы переписать ранее существующий файл?». Если мы не хотим, чтобы Excel при каждом сохранении спрашивал нас — подавляем это предупреждение.
5. Сохраняем файл с помощью метода SaveAs. Обратите внимание, что мы пишем полный адрес, включая имя файла с расширением (при сохранении на рабочий стол
   ActiveWorkbook.SaveAs CreateObject(«WScript.Shell»). SpecialFolders(«Desktop») & «Отчет на 2016.xlsx»).
6. Поскольку мы запретили показывать системные сообщения в пункте 4, мы должны включить их обратно. Если этого не сделать Excel будет подавлять все предупреждения, что не
   допустимо.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

1. Активируйте редактор Visual Basic, нажав ALT + F11.
2. Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
3. Выберите Insert➜Module.
4. Введите или вставьте код во вновь созданном модуле.
5. Измените имя листа, диапазон ячеек, и место сохранения файла.

Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

Сначала, макрос создаёт папку для будущих текстовых файлов.
Папка создаётся в том же каталоге, где расположена книга Excel.

Далее, для каждой строки таблицы, макрос формирует подпапку,
используя в качестве её названия текст из 7-го столбца таблицы.

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,
и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.
После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

По окончании работы макроса, открывается папка, содержащая созданные текстовые файлы.

Пример макроса смотрите в прикреплённом файле.

---

Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов()

    On Error Resume Next

    Dim cell As Range, ra As Range

    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)

    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")

    ' создаём главную папку

    BaseFolder$ = ThisWorkbook.Path & "Товар по группам": MkDir BaseFolder$

    ' перебираем все строки

    For i = LBound(arr) To UBound(arr)

        ' создаём папку для очередной строки (если папки ещё нет)

        Folder$ = BaseFolder$ & arr(i, 7) & ""    ' имя папки - в столбце G

        MkDir Folder$

        ' формируем имя создаваемого текстового файла

        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"

        ' создаём файл в кодировке Unicode

        Set ts = FSO.CreateTextFile(Filename$, True, True)

        ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца

        ts.Close

        ' если текстовый файл нужен в другой кодировке

        ChangeFileCharset Filename$, "utf-8"

    Next i

    Set ts = Nothing: Set FSO = Nothing

    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"

    ' открываем папку с файлами

    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"

End Sub

Вложение	Размер	Загрузки	Последняя загрузка
prays.xls	38.5 КБ	170	8 часов 11 минут назад

• 35605 просмотров

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014

#1 06.09.2014 23:19:21 Доброе время суток. Есть книга, в ячейке А1 значение. Код Sub New2()     Dim New_Wb As Workbook     Set New_Wb = Workbooks.Add     New_Wb.Activate     New_Wb.SaveAs ("D:test" & "1" & ".xls")     New_Wb.Close End Sub Запускаю макрос, создается новая книга сохраняется по пути D:test, присваивается имя 1.xls и закрывается. Проблема в следующем, как переписать макрос, чтобы новая книга сохранялась с названием как в ячейке А1 книги, с которой запускается макрос? Заранее спасибо!

Alexander88 Пользователь Сообщений: 400 Регистрация: 02.09.2014	#2 06.09.2014 23:32:21 Попробуйте заменить пятую строку на: Код New_Wb.SaveAs ("D:test" & Cells(1, 1) & ".xls") Изменено: Alexander88 — 06.09.2014 23:32:32

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	#3 06.09.2014 23:35:54 Код Sub New2()     Dim New_Wb As Workbook     Set New_Wb = Workbooks.Add     New_Wb.Activate     New_Wb.SaveAs ("D:test" & ThisWorkbook.Sheets("Лист1").Range("A1") & ".xls")     New_Wb.Close End Sub

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014	#4 06.09.2014 23:38:01 Цитата Alexander88 пишет: заменить пятую строку на: ошибку дает (

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	#5 06.09.2014 23:39:26 Цитата evgeniy_m пишет: ошибку дает Это не информация — всегда следует указывать — КАКУЮ ошибку получаете.

	И пример Юрия с указанием откуда берется ячейка не работает?

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014	макрос не компилируеться..

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле

The_Prist Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office	evgeniy_m, Лист1 в книге с макросом присутствует? Что означает «макрос не компилируется»? Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014

#10 06.09.2014 23:55:12 Цитата Юрий М пишет: Мой вариант проверяли? супер! Огромное спасибо ! ПОмогите еще с одним моментом, книгу создал, обозвал её как Вы помогли, теперь беда… Хочу с книги откуда запускал макрос скопировать лист (plan) в эту новую книгу с созданым листом «plan_191». Код Dim sShName As String, sAddress As String, vData     Dim objThisBook As Object     Set objThisBook = GetObject.ActiveWorkbook     sAddress = "A1:AA6000"     vData = objCloseBook.Sheets("plan").Range(sAddress).Value     objThisBook.Close False     Sheets("plan_191").Range("A1").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData но на строке  Set objThisBook = GetObject.ActiveWorkbook дает ошибку…. как мне указать, что нужно копировать лист из книги откуда запускался макрос….?

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012	#11 07.09.2014 00:01:23 Цитата evgeniy_m пишет: Хочу с книги откуда запускал макрос скопировать лист (plan) в эту новую книгу с созданым листом «plan_191». Ничего не понятно (а в приложенном макросе вообще какая-то, извините, ерунда). There is no knowledge that is not power

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	#12 07.09.2014 00:04:40 Код Sub New2()     Dim New_Wb As Workbook     Set New_Wb = Workbooks.Add     ThisWorkbook.Sheets("plan").Copy     New_Wb.Sheets.Add After:=New_Wb.Sheets(Sheets.Count)     New_Wb.SaveAs ("D:test" & ThisWorkbook.Sheets("Лист1").Range("A1") & ".xls")     New_Wb.Close End Sub

Hugo Пользователь Сообщений: 23253 Регистрация: 22.12.2012	#13 07.09.2014 00:05:00 скопировать лист (plan) в эту новую книгу — Код sheets("plan").copy получите новую книгу с одним листом, который затем можете переименовать. Только при таком копировании пострадают длинные строки в ячейках, если они конечно есть. Хотя в новых экселях не проверял…

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014	Суть такая, открываю книгу, запускаю макрос, создается новая книга и лист в ней. Теперь из 1-й книги нужно скопировать лист в новую книгу. Помогите пожалуйста

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	Согласен с Johny: ерунда получается — сначала имя листа «plan», затем «plan_191″…

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	evgeniy_m, у Дмитрия (The_Prist) очень хороший текст в подписи — прочитайте))

	Может проще создать копию книги, а потом удалить листы кроме нужного?

Hugo Пользователь Сообщений: 23253 Регистрация: 22.12.2012	Кстати хороший вариант сделать копию файла, его открыть, поудалять лишнее. Так и строки не пострадают, и связи…

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014

#19 07.09.2014 00:12:45 Код Dim sShName As String, sAddress As String, vData     Dim objThisBook As Object     Set objThisBook = GetObject("d:test.xls")     sAddress = "A1:AA6000"     vData = objThisBook.Sheets("abs_plan").Range(sAddress).Value     Sheets("abs_plan_191").Range("A1").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData Вот написал, все отлично работает, но копирует без сохранения параметров ячеек…

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012	#20 07.09.2014 00:14:18 Так? Код Sub F()     Dim wkbNew As Workbook     Sheets("plan").Copy     Set wkbNew = ActiveWorkbook     wkbNew.Sheets(1).Name = "plan_191"     wkbNew.SaveAs "D:test" & ThisWorkbook.Sheets("Лист1").Range("A1") & ".xls"      End Sub There is no knowledge that is not power

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	evgeniy_m, Вы читаете, что Вам пишут?

evgeniy_m Пользователь Сообщений: 109 Регистрация: 07.07.2014

Honey Пользователь Сообщений: 204 Регистрация: 06.02.2015

#23 30.05.2017 13:54:20 Всем привет! Надеюсь мой вопрос здесь уместен. Я под основу взяла код, предлагаемый здесь. Но его чуток видоизменила. И теперь у меня проблема-выдает ошибку на строку Код New_Wb.SaveAs А сам код вот Код Dim New_Wb As Workbook     Set New_Wb = Workbooks.Add     New_Wb.Activate     New_Wb.SaveAs (Range("O6") & "" & Range("Книга") & ".xlsm") либо Код Dim New_Wb As Workbook     Set New_Wb = Workbooks.Add     New_Wb.Activate     New_Wb.SaveAs ("M:ProductionМастера2017Нормализация" & Range("имя_папки").Value & "" & Range("Книга") & ".xlsm") Спасибо Изменено: Honey — 30.05.2017 13:57:38

Honey Пользователь Сообщений: 204 Регистрация: 06.02.2015	Люди добрые! Помогите с проблемой выше, пожалуйста… Интернет обыскала ничего не получается((( Вся надежда на Вас

The_Prist Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office

#25 21.06.2017 08:46:59 Цитата Honey написал: выдает ошибку что за ошибка — нам угадать? Да и скобки здесь лишние. В VBA методы без присвоения результата переменной указываются без скобок: Код New_Wb.SaveAs Range("O6") & "" & Range("Книга") & ".xlsm" плюс очень желательно указывать формат файла явно: Код New_Wb.SaveAs Range("O6") & "" & Range("Книга") & ".xlsm", 52 52 — формат xslm. Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Honey Пользователь Сообщений: 204 Регистрация: 06.02.2015	The_Prist,  спасибо, что откликнулись! Ошибка Runtime error 1004:: Method ‘Range’ of Global Failed Изменено: Honey — 21.06.2017 08:56:57

The_Prist Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office

А Вы вдумайтесь в ошибку. В Google-переводчик закиньте. Тогда видно будет, что у Вас проблема в том, что нет диапазона «Книга» или «Об» или другого, чего Вы пишите в Range. Так же надо помнить, что указание Range явного указания для него листа и книги подразумевает обращение к АКТИВНОЙ книге. А Вы её только что создали. Следовательно там НЕТ ИМЕНОВАННЫХ ДИАПАЗОНОВ, да и вообще данных. Советую очень внимательно изучить: Как обратиться к диапазону из VBA Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Honey Пользователь Сообщений: 204 Регистрация: 06.02.2015	Во вложении файл, в котором этот самый макрос (модуль) Прикрепленные файлы Расчет.xlsm (76.72 КБ) Изменено: Honey — 21.06.2017 09:06:17

Honey Пользователь Сообщений: 204 Регистрация: 06.02.2015	The_Prist, Об этом я читала… Видимо, действительно, я чего-то не понимаю((( У меня есть такие диапазоны. И я ведь указываю на имена диапазонов не в ново-созданной книге. Или как мне конкретней указать, чтобы диапазон брался конкретно с первоначальной книги для именования…? Спасибо за ссылочку)) Изменено: Honey — 21.06.2017 09:09:17

The_Prist Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office	#30 21.06.2017 09:20:23 Цитата Honey написал: указываю на имена диапазонов не в ново-созданной книге нет. Я же написал, что указание Range без явного указания листа и книги в Вашем случае указывает на активный лист. А т.к. Вы это делаете после создания новой книги — то активна именно она, а не что-то там где-то еще. Видимо, читали либо не все, либо не то, либо не так. Код New_Wb.SaveAs ThisWorksbook.Sheets("1 норм").Range("O6") & "" & ThisWorksbook.Sheets("1 норм").Range("Книга") & ".xlsm", 52 Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Как я могу создать новый файл Excel/Workbook в VBA, не открывая его автоматически? Создать файл vba excel

Создание и запись в текстовый файл с использованием макроса excel и VBA

Вы можете объединить данные в массив и затем преобразовать его в текст.

Sub ExcelToTxt() ‘Declaring variables Dim i As Long, j As Integer Dim n As Long, k As Long Dim destgroup As String Dim FName As String Dim vDB, vR(1 To 6), vJoin(), vResult() Dim sJoin As String, sResult As String Dim s As Long ‘Activate Sheet1 Sheet1.Activate ‘Find the last row that contains data With Sheet1 vDB = .Range(«a1»).CurrentRegion ‘<~~ get data to array from your data range n = UBound(vDB, 1) ‘size of array (row of 2 dimension array) End With ‘Create txt file FName = Application.GetSaveAsFilename(«», «txt file (*.txt), *.txt») For i = 2 To n ‘<~~loop destgroup = vDB(i, 2) ‘<~~ second column If destgroup = «trex_15hz» Or destgroup = «trex_10hz» Or destgroup = «trex_5hz» Then vR(1) = «; ### LABEL DEFINITION ###» ‘<~~ text 1st line s = Val(Replace(vDB(i, 3), «label», «»)) vR(2) = «EQ_LABEL_DEF,02,» & Format(s, «000») vR(3) = «UDB_LABEL,» & Chr(34) & vDB(i, 4) & Chr(34) ‘<~~ 2nd line ReDim vJoin(4 To 7) vJoin(4) = Chr(34) & vDB(i, 4) & Chr(34) For j = 5 To 7 vJoin(j) = vDB(i, j) Next j sJoin = Join(vJoin, «,») vR(4) = «STD_SUB_LABE,» & sJoin ‘<~~ 3th line ReDim vJoin(8 To 12) vJoin(8) = Chr(34) & UCase(vDB(i, 8)) & Chr(34) vJoin(9) = Chr(34) & vDB(i, 9) & Chr(34) vJoin(10) = Format(vDB(i, 10), «#.000000000») For j = 11 To 12 vJoin(j) = vDB(i, j) Next j sJoin = Join(vJoin, «,») vR(5) = «STD_SUB_LABE,» & sJoin ‘<~~ 4the line vR(6) = «END_EQ_LABEL_DEF» ‘<~~ 5th line k = k + 1 ReDim Preserve vResult(1 To k) vResult(k) = Join(vR, vbCrLf) ‘<~~ 5 line in array vR and get to array vResult with join method End If Next i sResult = «EQUIPMENT_ID_DEF,02,0×1,» & Chr(34) & «trex» & Chr(34) ‘<~~ text file first line sResult = sResult & vbCrLf & Join(vResult, vbCrLf) ‘<~~ combine 1th and other line ConvertText FName, sResult ‘<~~ sub presedure End Sub Sub ConvertText(myfile As String, strTxt As String) Dim objStream Set objStream = CreateObject(«ADODB.Stream») With objStream ‘.Charset = «utf-8» .Open .WriteText strTxt .SaveToFile myfile, 2 .Close End With Set objStream = Nothing End Sub

stackoverrun.com

Macro VBA Excel создать дату файла XML

с макросом VBA в Excel Мне нужно преобразовать дату на 1 лист в файл excel. Для этого я уже создал скрипт, но у меня есть проблема, чтобы правильно генерировать дату в XML. Мне нужна первая строка заголовка, а затем формула считывает все строки с данными.

Sub createXML() Sheets(«Sheet1»).Select FullPath = baseDirectory & projectName & «xmlBatchinputTest.xml» Set objStream = CreateObject(«ADODB.Stream») objStream.Charset = «iso-8859-1» objStream.Open objStream.WriteText («<?xml version=’1.0′ encoding=’UTF-8′?>» & vbLf) objStream.WriteText («<y:input xmlns:y=’http://www.test.com/engine/3′>» & vbLf) objStream.WriteText (» <y:datas>» & vbLf) objStream.WriteText (» <y:instance yid=’theGeneralData’>» & vbLf) objStream.WriteText («» & vbLf) objStream.WriteText («<language yid=’LANG_en’ />» & vbLf) objStream.WriteText («<client yclass=’Client’>» & vbLf) objStream.WriteText (» <firstName>» & Cells(1, 1).Text & «</firstName>» & vbLf) objStream.WriteText (» <lastName>» & Cells(1, 2).Text & «</lastName>» & vbLf) objStream.WriteText (» <age>» & Cells(1, 3).Text & «</age>» & vbLf) objStream.WriteText (» <civility yid='» & toYID(Cells(1, 4).Text) & «‘ />» & vbLf) objStream.WriteText («</client>» & vbLf) objStream.WriteText («» & vbLf) objStream.WriteText (» </y:instance>» & vbLf) objStream.WriteText (» </y:datas>» & vbLf) objStream.WriteText («</y:input>» & vbLf) objStream.SaveToFile FullPath, 2 objStream.Close End Sub

данные Excel теперь в этом формате:

enter image description here

Но мой выход для теперь это:

> <?xml version=’1.0′ encoding=’UTF-8′?> <y:input xmlns:y=’http://www.test.com/engine/3′> <y:datas> <y:instance yid=’theGeneralData’> <language yid=’LANG_en’ /> <client yclass=’Client’> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid=’CIVILITY’ /> </client> </y:instance> </y:datas> </y:input>

Нам нужно иметь этот результат:

> <?xml version=’1.0′ encoding=’UTF-8′?> <y:input xmlns:y=’http://www.test.com/engine/3′> <y:datas> <y:instance yid=’theGeneralData’> <language yid=’LANG_en’ /> <client yclass=’Client’> <firstName>1</firstName> <lastName>1</lastName> <age>1</age> <civility yid=’CIVILITY’ /> </client> <client yclass=’Client’> <firstName>2</firstName> <lastName>2</lastName> <age>2</age> <civility yid=’CIVILITY’ /> </client> <client yclass=’Client’> <firstName>3</firstName> <lastName>3</lastName> <age>3</age> <civility yid=’CIVILITY’ /> </client> </y:instance> </y:datas> </y:input>

stackoverrun.com

Создайте цикл, чтобы открыть несколько файлов и скопировать данные в главный файл в VBA excel

У меня есть несколько файлов с данными, которые необходимо перенести в один главный файл со всеми данными в одну строку.

Я полный нуб в программировании, так что если код, который я до сих пор не имеет никакого смысла, то, пожалуйста, не стесняйтесь, чтобы изменить его

я смог найти это «Loop всех Excel файлов в папка «с сайта www.TheSpreadsheetGuru.com Код работает отлично, он откроет каждый файл отдельно в папке, а затем закроет его, а затем откроет следующий файл и закроет его, пока он не пройдет через каждый файл в этой папке ,

Однако я хотел бы вставить цикл цикла «копировать и вставлять данные» в цикл. Итак, что должно произойти, код откроет «File1» в папке, а затем скопирует и вставляет данные в «Мастер-файл» в ячейке A4. Затем он закроет «File1», а затем откройте «File2» и скопируйте данные в «Мастер-файл» в ячейке A5, а затем закройте «File2». Он повторит это, пока все файлы в папке не будут открыты/закрыты.

Это код, который у меня есть прямо сейчас, но я не могу заставить код для копирования и вставки правильно работать. Мне сложно определить, как установить цикл, где код будет знать, в каком файле он находится сейчас, и установить счетчик для ячейки основного файла, в который он вставляется.

Sub LLoopAllExcelFilesInFolder() ‘PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them ‘SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog ‘Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual ‘Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = «March» .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & «» End With ‘In Case of Cancelhow NextCode: myPath = myPath If myPath = «» Then GoTo ResetSettings ‘Target File Extension (must include wildcard «*») myExtension = «*.xlsx» ‘Target Path with Ending Extention myFile = Dir(myPath & myExtension) ‘Loop through each Excel file in folder Do While myFile <> «» ‘Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) ‘THIS IS MY COPY AND PASTE CODE (DOESN’T WORK) Dim row As Integer While row = 4 Workbooks(«Filename:=myPath & myFile»).Worksheets(«Resin Log»).cell(«I5») = Workbooks(«Workbook1.xlsm»).Worksheets(«Sheet1»).Range(«A» & row).Value Next row ‘Save and Close Workbook wb.Close SaveChanges:=False ‘Get next file name myFile = Dir Loop ‘Message Box when tasks are completed MsgBox «Task Complete!» ResetSettings: ‘Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

stackoverrun.com

Решение: Создание текстового файла — VBA

Необходимо создать текстовый файл: Создать типизированный файл, содержащий данные о фирмах: название фирмы, фамилия и инициалы владельца (одно поле), адрес (три поля: город, улица, дом), телефон. Переписать в текстовый файл и вывести в ячейки эл. таблицы данные о владельцах фирм, фамилия которых начинается с буквы М; Делаю по образу в методичке:Sub create_file_txt()  Dim F As FIRMA  Dim kol As Integer  Dim str As String    kol = InputBox(«введите количество фирм»)  Open «C:UsersВиталийDesktopVB и VBAЗаданияЕкатерина Корожбинаfirma» For Random As #1 Len = Len(F)    For I = 1 To kol     F.FIRMA = InputBox(«Введите название фирмы:»)     F.fio = InputBox(«Введите фамилию, имя, отчество:»)     F.city = InputBox(«Введите город:»)     F.street = InputBox(«Введите название улиц:»)     F.house = InputBox(«Введите номер дома:»)     F.telefon = InputBox(«Введите номер телефона:»)     ‘str = CStr(F.FIRMA) + «,» + CStr(F.fio) + «,» + CStr(F.city) + «,» + CStr(F.street) + «,» + CStr(F.house) + «,» + CStr(F.telefon)    Put #1, I, F Next I    Close #1 End SubНо выдает ошибку: Run-time error 59 Bad record lenght Пробовала формировать строкуSub create_file_txt()  Dim F As FIRMA  Dim kol As Integer  Dim str As String    kol = InputBox(«ГўГўГҐГ¤ГЁГІГҐ êîëè÷åñòâî ôèðì»)  Open «C:UsersÂèòГ*ëèéDesktopVB ГЁ VBAГ‡Г*Г¤Г*Г*ГЁГїГ…ГЄГ*òåðèГ*Г* ÊîðîæáèГ*Г*firma» For Random As #1 Len = Len(F)    For I = 1 To kol     F.FIRMA = InputBox(«Введите название фирмы:»)     F.fio = InputBox(«Введите фамилию, имя, отчество:»)     F.city = InputBox(«Введите город:»)     F.street = InputBox(«Введите название улиц:»)     F.house = InputBox(«Введите номер дома:»)     F.telefon = InputBox(«Введите номер телефона:») ‘ *****    str = CStr(F.FIRMA) + «,» + CStr(F.fio) + «,» + CStr(F.city) + «,» + CStr(F.street) + «,» + CStr(F.house) + «,» + CStr(F.telefon) ‘ *****    Put #1, I, str        ‘ Put #1, I, F.fio  ‘, f.fio» ‘, f.city , f.street, f.house , f.telefon Next I    Close #1 End Subтакже выдает ошибку: Run-time error 59 Bad record lenght Как мне записать данные в txt файл?

studassistent.ru

Создание текстовых файлов по таблице Excel

Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

Сначала, макрос создаёт папку для будущих текстовых файлов.Папка создаётся в том же каталоге, где расположена книга Excel.

Далее, для каждой строки таблицы, макрос формирует подпапку,используя в качестве её названия текст из 7-го столбца таблицы.

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

По окончании работы макроса, открывается папка, содержащая созданные текстовые файлы.

Пример макроса смотрите в прикреплённом файле.

Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов() On Error Resume Next Dim cell As Range, ra As Range Set ra = Range([A2], Range(«A» & Rows.Count).End(xlUp)).Resize(, 11) arr = ra.Value ‘ считываем данные в массив Set FSO = CreateObject(«scripting.filesystemobject») ‘ создаём главную папку BaseFolder$ = ThisWorkbook.Path & «Товар по группам»: MkDir BaseFolder$   ‘ перебираем все строки For i = LBound(arr) To UBound(arr) ‘ создаём папку для очередной строки (если папки ещё нет) Folder$ = BaseFolder$ & arr(i, 7) & «» ‘ имя папки — в столбце G MkDir Folder$   ‘ формируем имя создаваемого текстового файла Filename$ = Folder$ & Trim(arr(i, 2)) & «.txt»   ‘ создаём файл в кодировке Unicode Set ts = FSO.CreateTextFile(Filename$, True, True) ts.Write Trim(arr(i, 10)) ‘ данные в файл — из ячейки 10-го столбца ts.Close   ‘ если текстовый файл нужен в другой кодировке ChangeFileCharset Filename$, «utf-8» Next i   Set ts = Nothing: Set FSO = Nothing MsgBox «Файлы созданы, и помещены в папку» & vbNewLine & BaseFolder$, vbInformation, «Готово»   ‘ открываем папку с файлами CreateObject(«wscript.shell»).Run «explorer.exe /e, «»» & BaseFolder$ & «»»» End Sub

prays.xls	38.5 КБ	233	27 недель 4 часа назад

ВложениеРазмерЗагрузкиПоследняя загрузка

excelvba.ru

vba — Как я могу создать новый файл Excel/Workbook в VBA, не открывая его автоматически?

Если вы планируете создавать 40 000 новых файлов, то .Add и .SaveAs замедлят ваш компьютер. И так как вы не хотите его открывать, я бы рекомендовал использовать ACE для этого. Вот краткий пример.

UNTESTED (на основе примера VB.Net ЗДЕСЬ)

Sub Sample() Dim cn As New ADODB.Connection, cmd As New ADODB.Command Dim FilePath As String Dim i As Long ‘~~> Folder to save the files FilePath = «C:Temp» For i = 1 To 40000 sFileName = FilePath & » File — » & i & «.xlsx» With cn .Provider = «Microsoft.ACE.OLEDB.12.0» .ConnectionString = «Data Source=» & sFileName & «Extended Properties=»»Excel 12.0 Xml;HDR=YES;» .Open Set cmd = New ADODB.Command cmd.ActiveConnection = cn ‘~~> Command to create the table cmd.CommandText = «CREATE TABLE Sheet1 (Sno Int, » & _ «Employee_Name VARCHAR, » & _ «Company VARCHAR, » & _ «Date_Of_joining DATE, » & _ «Stipend DECIMAL, » & _ «Stocks_Held DECIMAL)» ‘~~> Adding Data cmd.CommandText = «INSERT INTO Sheet1 (Sno, Employee_Name, » & _ «Company,Date_Of_joining,Stipend,Stocks_Held) » & _ «values (‘1’, ‘Siddharth Rout’, ‘Defining Horizons’, » & _ «’20/7/2014′,’2000.75′,’0.01′)» cmd.Execute .Close End With Next i End Sub

qaru.site

Создание текстового файла и ввод текста в файл

Sub Test()

Open «c:2.txt» For Output As #1

Print #1, «Hello File»

Close #1

Open «c:1.txt» For Input As #1

Dim s As String

Input #1, s

MsgBox s

Close #1

End Sub

Создание текстового файла и ввод текста (определение конца файла)

Sub Test()

Open «c:1.txt» For Output As #1

Print #1, «Hello , File»

Close #1

Open «c:1.txt» For Input As #1

Dim s As String

While Not EOF(1)

Input #1, s

MsgBox s

Wend

Close #1

End Sub

Создание документов Word на основе таблицы Excel

Sub ReportToWord()

Dim intReportCount As Integer ‘ Количество сообщений

Dim strForWho As String ‘ Получатель сообщения

Dim strSum As String ‘ Сумма за товар

Dim strProduct As String ‘ Название товара

Dim strOutFileName As String ‘ Имя файла для сохранения сообщения

Dim strMessage As String ‘ Текст дополнительного сообщения

Dim rgData As Range ‘ Обрабатываемые ячейки

Dim objWord As Object

Dim i As Integer

‘ Создание объекта Word

Set objWord = CreateObject(«Word.Application»)

‘ Информация с рабочего листа

Set rgData = Range(«A1»)

strMessage = Range(«E6»)

‘ Просмотр записей на листе Лист1

intReportCount = Application.CountA(Range(«A:A»))

For i = 1 To intReportCount

‘ Динамические сообщения в строке состояния

Application.StatusBar = «Создание сообщения » & i

‘ Назначение данных переменным

strForWho = rgData.Cells(i, 1).Value

strProduct = rgData.Cells(i, 2).Value

strSum = Format(rgData.Cells(i, 3).Value, «#,000»)

‘ Имя файла для сохранения отчета

strOutFileName = ThisWorkbook.path & «» & strForWho & «.doc»

‘ Передача команд в Word

With objWord

.Documents.Add

With .Selection

‘ Заголовок сообщения

.Font.Size = 14

.Font.Bold = True

.ParagraphFormat.Alignment = 1

.TypeText Text:=»О Т Ч Е Т»

‘ Дата

.TypeParagraph

.TypeParagraph

.Font.Size = 12

.ParagraphFormat.Alignment = 0

.Font.Bold = False

.TypeText Text:=»Дата:» & vbTab & _

Format(Date, «mmmm d, yyyy»)

‘ Получатель сообщения

.TypeParagraph

.TypeText Text:=»Кому: менеджеру » & vbTab & strForWho

‘ Отправитель

.TypeParagraph

.TypeText Text:=»От:» & vbTab & Application.UserName

‘ Сообщение

.TypeParagraph

.TypeParagraph

.TypeText strMessage

.TypeParagraph

.TypeParagraph

‘ Название товара

.TypeText Text:=»Продано товара:» & vbTab & strProduct

.TypeParagraph

‘ Сумма за товар

.TypeText Text:=»На сумму:» & vbTab & _

Format(strSum, «$#,##0»)

End With

‘ Сохранение документа

.ActiveDocument.SaveAs FileName:=strOutFileName

End With

Next i

‘ Удаление объекта Word

objWord.Quit

Set objWord = Nothing

‘ Обновление строки состояния

Application.StatusBar = False

‘ Вывод на экран информационного сообщения

MsgBox intReportCount & » заметки создано и сохранено в папке » _

& ThisWorkbook.path

End Sub

Команды создания и удаления каталогов

Sub Test()

MkDir («c:test»)

End Sub

И удаляем.

Sub Test()

RmDir («c:test»)

End Sub

Получение текущего каталога

Sub Test()

MsgBox (CurDir)

End Sub

Смена каталога

Sub Test()

ChDir («c:windows»)

MsgBox (CurDir)

End Sub

Посмотреть все файлы в каталоге_1

Sub Test()

Dim s As String

s = Dir(«c:windowsinf*.*»)

Debug.Print s

Do While s «»

s = Dir

Debug.Print s

Loop

End Sub

Посмотреть все файлы в каталоге_2

‘ Объявление API-функции для отображения стандартного окна _

просмотра папок

Declare Function SHBrowseForFolder Lib «shell32.dll» _

Alias «SHBrowseForFolderA» (lpBrowseInfo As BROWSEINFO) As Long

‘ Объявление API-функции для преобразования данных, возвращаемых _

функцией SHBrowseForFolder, в строку

Declare Function SHGetPathFromIDList Lib «shell32.dll» _

Alias «SHGetPathFromIDListA» (ByVal pidl As Long, ByVal _

pszPath As String) As Long

‘ Структура используется функцией SHBrowseForFolder

Type BROWSEINFO

hwndOwner As Long ‘ Родительское окно (для диалога)

pidlRoot As Long ‘ Корневая папка для просмотра

strDisplayName As String

strTitle As String ‘ Заголовок окна

ulFlags As Long ‘ Флаги для окна

‘ Следующие три параметра в VBA не используются

lpfn As Long

lParam As Long

iImage As Long

End Type

Sub BrowseFolder()

Dim strPath As String ‘ Папка, список файлов которой выводится

Dim strFile As String

Dim intRow As Long ‘ Текущая строка таблицы

‘ Выбор папки

strPath = dhBrowseForFolder()

If strPath = «» Then Exit Sub

If Right(strPath, 1) «» Then strPath = strPath & «»

‘ Оформление заголовка отчета

ActiveSheet.Cells.ClearContents

ActiveSheet.Cells(1, 1) = «Имя файла»

ActiveSheet.Cells(1, 2) = «Размер»

ActiveSheet.Cells(1, 3) = «Дата/время»

ActiveSheet.Range(«A1:C1»).Font.Bold = True

‘ Просмотр объектов в папке…

‘ Первый объект папки

strFile = Dir(strPath, 7)

intRow = 2

Do While strFile «»

‘ Запись в столбец «A» имени файла

ActiveSheet.Cells(intRow, 1) = strFile

‘ Запись в столбец «B» размера файла

ActiveSheet.Cells(intRow, 2) = FileLen(strPath & strFile)

‘ Запись в столбец «C» времени изменения файла

ActiveSheet.Cells(intRow, 3) = FileDateTime(strPath & strFile)

‘ Следующий объект папки

strFile = Dir

intRow = intRow + 1

Loop

End Sub

Function dhBrowseForFolder() As String

Dim biBrowse As BROWSEINFO

Dim strPath As String

Dim lngResult As Long

Dim intLen As Integer

‘ Заполнение полей структуры BROWSEINFO

‘ Корневая папка — Рабочий стол

biBrowse.pidlRoot = 0&

‘ Заголовок окна

biBrowse.strTitle = «Выбор папки»

‘ Тип возвращаемой папки

biBrowse.ulFlags = &h2

‘ Вывод стандартного окна просмотра папок

lngResult = SHBrowseForFolder(biBrowse)

‘ Обработка результата работы окна

If lngResult Then

‘ Получение пути (по возвращенным данным)

strPath = Space$(512)

If SHGetPathFromIDList(ByVal lngResult, ByVal strPath) Then

‘ Строка пути заканчивается символом Chr(0)

intLen = InStr(strPath, Chr$(0))

‘ Выделение и возврат пути

dhBrowseForFolder = Left(strPath, intLen — 1)

Else

‘ Не удалось получить путь

dhBrowseForFolder = «»

End If

Else

‘ Пользователь нажал кнопку «Отмена»

dhBrowseForFolder = «»

End If

End Function

topuch.ru

---

Работа с книгой Excel
создание, сохранение, закрытие, открытие

В этом уроке я продемонстрирую способы создания книги Excel, её сохранение, закрытие и всё это средствами VBA.

Создание новой книги Excel

Для того чтобы создать новую книгу, лист или что-то другое используют команду Add. Следовательно, для того чтобы создать новую книгу необходимо из выпадающего списка при написании команды книги выбрать Add:

Sub primer1()

Workbooks.Add

End Sub

Но при такой записи книга создаётся с настройками по умолчанию, т.е. если у Вас в Excel написано, что при создании новой книги в ней создавать 3 листа, то при написании вышеуказанной команды у Вас создастся книга с 3 листами. Почему я на это обратил внимание? Исходя из личного опыта знаю, что при формировании новых книг требуется создать книгу с указанным количеством листов. В примере ниже указано как создать книгу с одним листом.

Sub primer2()

Workbooks.Add (xlWBATWorksheet)

End Sub

Для того чтобы создать книгу с большим количеством листов необходимо дописать предыдущий код и указать дополнительное количество создаваемых листов. Смотрим.

Sub primer3()

Workbooks.Add(xlWBATWorksheet).Worksheets.Add , , 2

End Sub

или

Sub primer4()

Workbooks.Add(xlWBATWorksheet).Worksheets.Add Count:=2

End Sub

В этом примере создаётся книга с одним листом и дополнительно в ней создаётся ещё два листа, то-есть книга с 3 листами.

Сохранение книги

Если Вы хотите убить сразу двух зайцев, создать книгу и сразу же её сохранить в нужном месте, то можете воспользоваться комбинированной командой:

Sub primer5()

Workbooks.Add.SaveAs «c:12345»

End Sub

Обратите особое внимание на подсказку при вводе данных. На ней явно показано какие именно параметры Вы можете установить на книгу при её сохранении, например поставить пароль на книгу.

Ниже представлен пример сохранения книги с паролем — 123

Sub primer6()

Workbooks.Add.SaveAs «C:12345», , «123»

End Sub

или

Sub primer7()

Workbooks.Add.SaveAs Filename:=»C:12345″, Password:=»123″

End Sub

Из всего выше приведённого хочу сделать одно весомое замечание. При сохранении книги она будет использовать тот формат, который у Вас установлен по умолчанию. В данном случае я работаю на 2010 версии Excel и у меня по умолчанию стоит формат с расширением .xlsx. Если вы хотите сохранить файл с другим расширением, то вам в коде необходимо прописать следующие параметры.

Sub primer8()

Workbooks.Add.SaveAs Filename:=»C:12345″, FileFormat:=xlNormal

End Sub

При такой записи файл автоматически будет сохраняться с расширением .xls. Вы можете и сами указать расширение файла в адресе файла, что приветствуется. Например:

Sub primer9()

Workbooks.Add.SaveAs Filename:=»C:12345.xls», FileFormat:=xlNormal

End Sub

Если у Вас книга уже создана и Вы её просто хотите сохранить в нужном месте, то можно воспользоваться следующими записями.

Для сохранения текущей книги:

ThisWorkbook.SaveAs Filename:=»C:12345.xls», FileFormat:=xlNormal

Для сохранения активной книги:

ActiveWorkbook.SaveAs Filename:=»C:12345.xls», FileFormat:=xlNormal

Что будет если не указать путь сохранения книги? Она у Вас сохранится по умолчанию в коренной папке, в винде это обычно папка «Мои документы».

Если у Вас уже сохранена книга на компьютере и Вы время от времени её редактируете, но сохранять вы хотите её при помощи какого-то макроса на том же самом месте, то для такой процедуры можно воспользоваться банальной надписью (сохранить эту книгу):

ThisWorkbook.Save

Возможно многие загнались вопросом: А как сохранить книгу в текущей папке? То-есть там где открыт корееной файл — Ваша программа. Есть такая интересная штука, которая определяет коренной путь активного файла. А зная коренной путь файла, мы можем новый создаваемый файл сохранить в текущей папке с вашей программой, что очень удобно. Например:

Sub primer10()

ChDir ThisWorkbook.Path

Workbooks.Add.SaveAs Filename:=ThisWorkbook.Path & «12345.xls», _

FileFormat:=xlNormal

End Sub

Казалось бы всё основное рассмотрели, но оказывается есть ещё один интересный способ сохранения. Все его знают. Это когда мы сами указываем имя книги и путь её сохранения, т.е. нам показывается такое окно:

Делается это при помощи команды GetSaveAsFilename. Например, можно выполнить сохранение так:

Sub primer101()

fileSaveName = Application.GetSaveAsFilename(fileFilter:=»File (*.xls), *.xls»)

If fileSaveName False Then

ThisWorkbook.SaveAs Filename:=fileSaveName, FileFormat:=xlNormal

MsgBox «Сохранено как » & fileSaveName, vbInformation, «Сохранён»

End If

End Sub

При этом fileFilter устанавливает ограничение на то, в каких именно расширениях можно сохранять книги. Но не забывайте про FileFormat, если устанавливаете несколько форматов сохранения файла.

Закрытие книги

Для того чтобы закрыть книгу можно применить следующие команды:

Для закрытия текущей и активной книги:

ThisWorkbook.Close

ActiveWorkbook.Close

Если у Вас открыто несколько книг и Вам необходимо закрыть определённую книгу, то Вы можете указать имя закрываемой книги, например:

Sub primer13()

Workbooks(«12345.xls»).Close

End Sub

И всё бы хорошо, но при закрытии книги бывает выползает сообщение

Для того чтобы не появлялось такое сообщение необходимо перед закрытием книги её сохранить, например:

Sub primer13()

Workbooks(«12345.xls»).Save

Workbooks(«12345.xls»).Close

End Sub

Если вы не хотите сохранять книгу, но вам необходимо её закрыть (предположим вы взяли из неё какие-то данные), то можно воспользоваться следующей записью, которую рассматривали в этом уроке. Книга закроется без сохранения, даже если в неё были внесены изменения.

Sub primer14()

Application.DisplayAlerts = False

Workbooks(«12345.xls»).Close

Application.DisplayAlerts = True

End Sub

Открытие документов Excel

Для того чтобы открыть книгу Excel нужно всего-то указать путь открываемого файла. Программно это будет выглядеть так:

Sub primer15()

Workbooks.Open «D:РаботаVBAerror.xls»

End Sub

Если Вы не знаете где находится файл, то можно воспользоваться командой GetOpenFilename. При использовании этой команды нам появится окно, в котором, так же как и при сохранении книги, можно указать расширения открываемых файлов.

На этом примере показано, что разрешено открыть два типа файлов — с расширением xls и расширением xlsx.

Sub primer16()

fileToOpen = Application.GetOpenFilename _

(«Files (*.xls), *.xls,Files (*.xlsx), *.xlsx»)

If fileToOpen False Then

MsgBox «Открывается файл » & fileToOpen

Workbooks.Open fileToOpen

End If

End Sub

Открытие сторонних программ
средствами VBA

Все загонялись таким вопросом — Как открыть из Excel другую программу или файл, например PDF, DOC или обычный калькулятор? Сегодня я хочу устранить этот вопрос. Существует несколько способов открытия. Я не буду заморачиваться и лезть в дебри, а покажу тот которым пользуюсь я. Способ, который всегда работает и который понятен.

Мы говорили о том как можно открыть книгу Excel в предыдущем уроке, но как открыть сторонний документ? Практически любую программу или файл можно открыть при момощи команды Shell. Но тут необходимо соблюдать следующую последовательность открытия файла:

1. необходимо запустить программу при помощи которой будет происходить открытие документа. Например, для открытия документа с расширением .doc нам необходимо запустить Word.
2. открыть файл.

ВНИМАНИЕ! Все примеры, которые будут демонстрироваться ниже, исключительно на программах, которые установлены у меня. У вас этих программ может не оказаться или иметь совершенно другой путь.

Открываем документы Word

Для того чтобы открыть документ Word необходимо руководствоваться выше указанной последовательностью. На примере это будет выглядеть так

Sub WordOpen()

‘Открываем программу, которая открывает документ

Programm = «c:Program FilesMicrosoft OfficeOffice14winword.exe»

‘Указываем адрес файла

File = «c:1.docx»

‘Открываем Файл

Shell Programm & » » & File, vbNormalFocus

End Sub

Это же можно записать без присвоения к переменным, но это выглядит одной длинной строчкой, что иногда не очень удобно.

Sub WordOpen()

Shell «c:Program FilesMicrosoft OfficeOffice14winword.exe» _

& » » & «c:1.docx», vbNormalFocus

End Sub

Ну а если указанного файла или программы нет, то можно воспользоваться командами обработки ошибок.

Sub WordOpen()

On Error GoTo Errorr

Shell «c:Program FilesMicrosoft OfficeOffice14winword.exe» _

& » » & «c:2.docx», vbNormalFocus

GoTo Ends

Errorr:

MsgBox «Файл не найден», vbCritical, «Ошибка»

Ends:

End Sub

vbNormalFocus — этот параметр показывает как именно открыть окно. В данном случае это говорит о том, что Окно в фокусе и открывается до исходного размера и положения.

Существует несколько типов констант открытия окон:

Константа	Значение	Описание
vbHide	0	Указывает, что при вызове функции Shell окно вызванной программы становится скрытым.
vbNormalFocus	1	Указывает, что при вызове функции Shell окно вызванной программы принимает обычный размер и фокус находится внутри него.
vbMinimizedFocus	2	Указывает, что при вызове функции Shell окно вызванной программы сворачивается и фокус находится внутри него.
vbMaximizedFocus	3	Указывает, что при вызове функции Shell окно вызванной программы разворачивается во весь экран и фокус находится внутри него.
vbNormalNoFocus	4	Указывает, что при вызове функции Shell окно вызванной программы принимает обычный размер и фокус находится за его пределами.
vbMinimizedNoFocus	6	Указывает, что при вызове функции Shell окно вызванной программы сворачивается и фокус находится за его пределами.

Открываем документы PDF

Оень распространён способ открытия документов PDF через Акробат, так как это одна из самых популярных программ. Но я ей не пользуюсь. Она слишком медленная и меня она не устраивает. Поэтому способ открытия при помощи программы Акробат я показывать не буду. А продемонстрирую как можно всё при пощи той же команды Shell открыть любой программой, которая Вам нравится для чтения PDF документов. Делается это по аналогии с предыдущими примерами. Только тут мы указываем программу для открытия PDF документов.

Sub PDFOpen()

‘Открываем программу, которая открывает документ

Programm = «c:Program FilesFoxit SoftwareFoxit ReaderFoxit Reader.exe»

‘Указываем адрес файла

Files = «c:jrc4558.pdf»

‘Открываем Файл

Shell Programm & » » & Files, vbNormalFocus

End Sub

Точно так же можно записать в одну строчку

Sub PDFOpen()

Shell «c:Program FilesFoxit SoftwareFoxit ReaderFoxit Reader.exe» & _

» » & «c:jrc4558.pdf», vbNormalFocus

End Sub

Открываем сторонние программы

По аналогии при помощи команды Shell можно открывать и отдельные программы. Например аудиопроигрыватель:

Sub AIMPOpen()

Shell «c:Program FilesAIMP3AIMP3.exe», vbNormalFocus

End Sub

или видеопроигрыватель

Sub VIDEOOpen()

Shell «c:Program FilesK-Lite Codec PackMedia Player Classicmpc-hc.exe», _

vbNormalFocus

End Sub

При этом путь к некоторым праграммам, можно не указывать.

Sub CalcOpen()

Call Shell(«Calc.exe», 1)

End Sub

или таким образом

Sub CalcOpen()

Shell «Calc.exe», 1

End Sub

Или можно вызвать справку Windows

Sub HelpOpen()

Call Shell(«winhelp.exe», 1)

End Sub

Открываем программу Word

Sub winwordOpen()

Shell «winword.exe», 1

End Sub

Открываем командную строку

Sub CmdOpen()

Shell «cmd.exe», 1

End Sub

Думаю, что стальные программы Вы теперь сами сможете открыть на основе этих примеров.

аблица символов

Все давно знают, что буквы и цифры — это обыкновенный код в определённой таблице символов.

ASCII (англ. American Standard Code for Information Interchange) — американская стандартная кодировочная таблица для печатных символов и некоторых специальных кодов.

ASCII представляет собой кодировку для представления десятичных цифр, латинского и национального алфавитов, знаков препинания и управляющих символов. Изначально разработанная как 7-битная, с широким распространением 8-битного байта ASCII стала восприниматься как половина 8-битной. В компьютерах обычно используют расширения ASCII с задействованным 8-м битом и второй половиной кодовой таблицы (например КОИ-8).
(Источник: Википедия)

Для чего вообще я затронул эту тему? Это больше для справки дано. Но и Excel не оставлю без внимания. Зная коды символов при помощи обычных циклов можно предположим перебрать все символы, которые у нас имеются. Ниже приведены две таблицы символов — от 0 до 127 и от 128 до 255. Символы с кодами от 0 до 31 относятся к служебным.

Символ 0 — 127

0		32	[space]	64	@	96	`
1		33	!	65	A	97	a
2		34	«	66	B	98	b
3		35	#	67	C	99	c
4		36	$	68	D	100	d
5		37	%	69	E	101	e
6		38	&	70	F	102	f
7		39	‘	71	G	103	g
8		40	(	72	H	104	h
9		41	)	73	I	105	i
10		42	*	74	J	106	j
11		43	+	75	K	107	k
12		44	,	76	L	108	l
13		45	—	77	M	109	m
14		46	.	78	N	110	n
15		47	/	79	O	111	o
16		48	0	80	P	112	p
17		49	1	81	Q	113	q
18		50	2	82	R	114	r
19		51	3	83	S	115	s
20		52	4	84	T	116	t
21		53	5	85	U	117	u
22		54	6	86	V	118	v
23		55	7	87	W	119	w
24		56	8	88	X	120	x
25		57	9	89	Y	121	y
26		58	:	90	Z	122	z
27		59	;	91	[	123	{
28		60		92		124	|
29		61	=	93	]	125	}
30		62		94	^	126	~
31		63	?	95	_	127

8, 9, 10 и 13 не имеют графического представления, но, в зависимости от применения, могут влиять на визуальное отображение текста.

Символ 128 — 255

128	Ђ	160		192	А	224	а
129	Ѓ	161	Ў	193	Б	225	б
130	‚	162	ў	194	В	226	в
131	ѓ	163	Ј	195	Г	227	г
132	„	164	¤	196	Д	228	д
133	…	165	Ґ	197	Е	229	е
134	†	166	¦	198	Ж	230	ж
135	‡	167	§	199	З	231	з
136	€	168	Ё	200	И	232	и
137	‰	169	©	201	Й	233	й
138	Љ	170	Є	202	К	234	к
139	‹	171	«	203	Л	235	л
140	Њ	172	¬	204	М	236	м
141	Ќ	173	—	205	Н	237	н
142	Ћ	174	®	206	О	238	о
143	Џ	175	Ї	207	П	239	п
144	ђ	176	°	208	Р	240	р
145	‘	177	±	209	С	241	с
146	’	178	І	210	Т	242	т
147	“	179	і	211	У	243	у
148	”	180	ґ	212	Ф	244	ф
149	•	181	µ	213	Х	245	х
150	–	182	¶	214	Ц	246	ц
151	—	183	·	215	Ч	247	ч
152		184	ё	216	Ш	248	ш
153	™	185	№	217	Щ	249	щ
154	љ	186	є	218	Ъ	250	ъ
155	›	187	»	219	Ы	251	ы
156	њ	188	ј	220	Ь	252	ь
157	ќ	189	Ѕ	221	Э	253	э
158	ћ	190	ѕ	222	Ю	254	ю
159	џ	191	ї	223	Я	255	я

Применение

Теперь можно приступить непосредственно к примерам. Как я получил все эти символы? Конечно же я не сидел и не набирал их из таблицы символов в Excel. Всё это делается гораздо проще. Существует очень интересная команда, которая способна из номера символа показать нам его символ.

Chr(charcode) — возвращает строку, содержащую символ, связанный с указанным кодом символа. Другими словами мы задаём номер символа, а нам выдаётся символ.

А если воспользоваться циклом и записать это в виде макроса, то можно получить сразу всю таблицу символов за считанные секунды.

Sub tablica()

For a = 0 To 255

Cells(a + 1, 2) = a

Cells(a + 1, 1) = Chr(a)

Next a

Beep ‘Гудок

End Sub

Chr(a) — в этой записи переменная a принимает значения от 0 до 255. Всё согласно написанному циклу.
Beep — это сигнал компьютера. В данном случае сигнализирует о прекращении выполнении макроса.

Хочу ещё кое-что отметить. В одном из уроков мы рассматривали как можно перенести текст в Msgbox на новую строку. Делается это при помощи команды vbNewLine. Так вот эту же команду можно выполнить при помощи записи Chr(13), которая так же означает перенос на новую строку.

Sub Primer()

MsgBox «Это первая строка» & vbNewLine & _

«Это вторая строка», vbInformation, «Пример»

End Sub

или

Sub Primer()

MsgBox «Это первая строка» & Chr(13) & _

«Это вторая строка», vbInformation, «Пример»

End Sub

Так же можно отобразить символ в информационном сообщении.

Sub Primer2()

MsgBox «Символ Chr(89) — это » & Chr(89), vbInformation, «Пример»

End Sub

Теперь зная как получить символы можно писать программы для подбора паролей. :-))

Запуск макроса из другого макроса

Отдельно написаный макрос — это хорошо, но ещё лучше если макросы будут запускать сами себя. Предположим один макрос выполняет анализ документа, второй редактирует документ, третий делает отчётный документ. Ни каких лишних движений мышкой и вмешательства пользователей. Всё автоматизировано.

А теперь посмотрим как запустить макрос из другого макроса. Существует несколько способов. Предположим у нас есть 2 макроса, один из которых закрашивает ячейку в зелёный цвет, а другой закрашивает её в синий цвет.

Sub videlenie()

If Cells(1, 1).Interior.ColorIndex = 4 Then

Else

Cells(1, 1).Interior.ColorIndex = 4

MsgBox «Выполнена зелёная заливка», vbInformation, «Пример»

End If

End Sub

Sub okras()

ActiveCell.Interior.ColorIndex = 5

MsgBox «Выполнена синяя заливка», vbInformation, «Пример»

End Sub

Способ №1

Просто пишите имя макроса в том месте где вы хотите его выполнить. В данном случае он написан в условии Если … То.

Sub videlenie()

If Cells(1, 1).Interior.ColorIndex = 4 Then

okras

Else

Cells(1, 1).Interior.ColorIndex = 4

MsgBox «Выполнена зелёная заливка», vbInformation, «Пример»

End If

End Sub

Sub okras()

ActiveCell.Interior.ColorIndex = 5

MsgBox «Выполнена синяя заливка», vbInformation, «Пример»

End Sub

Если ячейка А1 имеет зелёный цвет, то запускается второй макрос (okras), который закрашивает её в синий цвет. Пройдите эти макросы через кнопку F8, дабы понять логику выполнения макроса. Это важно понимать.

Способ №2

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

Sub videlenie()

If Cells(1, 1).Interior.ColorIndex = 4 Then

Call okras

Else

Cells(1, 1).Interior.ColorIndex = 4

MsgBox «Выполнена зелёная заливка», vbInformation, «Пример»

End If

End Sub

Sub okras()

ActiveCell.Interior.ColorIndex = 5

MsgBox «Выполнена синяя заливка», vbInformation, «Пример»

End Sub

Не обязательно использовать оператор Call при вызове процедуры. Однако он повышает читаемость кода. Лично я всегда использую этот вариант.

Способ №3

Третий способ более замороченый (его дольше писать), но им тоже можно пользоваться. Макрос запускается при помощи команды Application.Run.

Sub videlenie()

If Cells(1, 1).Interior.ColorIndex = 4 Then

n = 1

Application.Run «okras»

Else

Cells(1, 1).Interior.ColorIndex = 4

MsgBox «Выполнена зелёная заливка», vbInformation, «Пример»

End If

End Sub

Sub okras()

ActiveCell.Interior.ColorIndex = 5

MsgBox «Выполнена синяя заливка» & n, vbInformation, «Пример»

End Sub

Ну вот. Теперь мы знаем как запускать макросы. Есть ещё один момент, который надо отметить. При запуске макросов иногда возникает необходимость переносить значения переменных из одного макроса в другой, чтобы в дальнейшем обработать необходимую информацию.

Перенос значений переменных из одного макроса в другой

Рассмотрим перенос значений переменных на двух простейших макросах.

Sub perenos()

a = 1

b = 2

c = a + b

End Sub

Sub rezultat()

MsgBox «Результат сложения» & vbNewLine & _

«a=1» & a & vbNewLine & _

«b=2» & b & vbNewLine & _

«равен » & c, vbInformation, «Пример»

End Sub

Для того чтобы перенести значение переменной c в макрос с именем rezultat, необходимо в скобках с именем макроса указать ту переменную, значение которой вы хотите перенести. Выглядит это следующим образом.

Sub perenos()

a = 1

b = 2

c = a + b

Call rezultat(c)

End Sub

Sub rezultat(c)

MsgBox «Результат сложения» & vbNewLine & _

«a=1» & a & vbNewLine & _

«b=2» & b & vbNewLine & _

«равен » & c, vbInformation, «Пример»

End Sub

Обратите особое внимание, что при запуске макроса, в скобках так же надо указывать переменную Call rezultat(c), так как имя макроса изменилось. Теперь при запуске первого макроса у нас запускается второй макрос в котором нам отображается результат.

Теперь усложним и перенесём значение переменных a и b в макрос rezultat, и уже в нём произведём вычисление. Выглядеть это будет так:

Sub perenos1()

a = 1

b = 2

Call rezultat1(a, b)

End Sub

Sub rezultat1(a, b)

c = a + b

MsgBox «Результат сложения» & vbNewLine & _

«a=» & a & vbNewLine & _

«b=» & b & vbNewLine & _

«равен » & c, vbInformation, «Пример»

End Sub