Как скопировать книгу в excel vba
Здравствуйте!
Перед внесением изменений в книгу, хочется сохранить его резервную копию и продолжить работу в оригинальной.
Я использую код, который сохраняет файл под новым именем, после чего снова пересохраняет под старым (с заменой файла).
Есть какой-то более изящный способ? Работаю с файлами формата Excel 97-2003, метод SaveCopyAs использовать не удаётся.
Сам код выглядит так:
P.S. пытался сохранять копию, открывать оригинал, закрывать копию,
но при этом макрос прекращает работу
(потому что выполняется из копии, а копию закрыли)
Спасибо!
Нужно сделать резервную копию БД Access из Excel-я
Help! Нужно сделать резервную копию БД Access из Excel-я, т.е. скопировать базу из рабочего.
Как создать полную резервную копию системы CentOC 6.3
Всем привет ! Подскажите пожалуйта как мне сделать полную копию всей системы CentOS 6.3 ? Дело в.
Lenovo IdeaPad U310. Как создать резервную USB копию?
Добрый день. Купил новый указанный ноутбук с предустановленным Виндоус 7 ХОМЕ премиум в комплекте.
Подскажите, как создать образ/резервную копию уже установленной ОС с программами или без программ, драйверами и т.д.?
Здравствуйте. Подскажите, как создать образ/резервную копию уже установленной ОС с программами или.
viper-x, а попроще не хотите, воспользовавшись FileCopy? Т.е. открываете свой файл, копируете его (копируется не тот, что в экселе, а тот, что на диске - первозданный) куда надо без SaveAs и продолжаете с ним работать. Почитайте про FileCopy
Burk, благодарю за подсказку!
Но, если я правильно понимаю,
в этом случае копируется открытый файл -
не будет из-за этого проблем?
Всегда ли корректно он копируется?
Добавлено через 6 минут
могу только добавить, что я этим не пользовался, но, думаю, работать будет, проверьте, может и вопросы отпадут.
когда эта книга открыта код выдаёт ошибку
Run-time error '70': Permission denied
когда закрыта - копируется.
думаю, это говорит о том, что скопировать
открытую книгу таким способом не удастся
viper-x, был уверен, что должно пройти, чего бы вдруг блокировать копирование, вот перемещение или удаление согласен. Недоработки экселя, но с этим приходится жить. Приду домой, посмотрю.
Добавлено через 2 часа 39 минут
viper-x, возможен такой вариант, не знаю будет ли он выглядеть лучше вашего, вам решать. Создаем файл-запускалку, который копирует ваш основной файл (он пока не открыт) через FileCopy, в следующей строке этого файла вызов вашего основного файла, а в основном файле в модуле ЭтаКнига в процедуре WorkBook_Open стоит закрытие запускалки.
Добавлено через 11 минут
Запускалку можно сделать как скрипт, тогда и закрывать её не нужно
Копирует лист в другое расположение в текущей книге или новой книге.
Синтаксис
выражения. Copy (Before, After)
выражение Переменная, представляюная объект "Таблица ".
Параметры
Имя | Обязательный или необязательный | Тип данных | Описание |
---|---|---|---|
Before | Необязательный | Variant | Лист, перед которым будет размещен скопирован лист. Вы не можете указать Перед , если указать После. |
After | Необязательный | Variant | Лист, после которого будет размещен скопирован лист. Вы не можете указать После, если вы указываете Раньше. |
Примечания
Если вы не указываете ни до, ни после, Microsoft Excel создает новую книгу, которая содержит скопированные объекты таблицы. Недавно созданная книга содержит свойство Application.ActiveWorkbook и содержит одну таблицу. В единой таблице сохраняются свойства name и CodeName исходных таблиц. Если скопированная таблица держала лист кода листа в проекте VBA, то это также осуществляется в новой книге.
Выбор массива из нескольких листов можно скопировать на новый пустой объект книги аналогичным образом.
Источник и назначение должны быть в одном Excel. Пример приложения, в противном случае он вызывает ошибку времени запуска '1004': Нет такого интерфейса поддерживается, Sheet1.Copy objWb.Sheets(1) если что-то подобное было использовано, или ошибка времени запуска '1004': Метод копирования класса Worksheet не удалось, ThisWorkbook.Worksheets("Sheet1").Copy objWb.Sheets(1) если что-то подобное было использовано.
Пример
В этом примере копируется Sheet1, размещая копию после Sheet3.
В этом примере сначала скопируется sheet1 в новую пустую книгу, а затем сохраняется и закрывается новая книга.
В этом примере листы Sheet1, Sheet2 и Sheet4 копируется в новую пустую книгу, а затем сохраняет и закрывает новую книгу.
Поддержка и обратная связь
Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.
Про сборку листов из нескольких книг в одну текущую я уже писал здесь. Теперь разберем решение обратной задачи: есть одна книга Excel, которую нужно "разобрать", т.е. сохранить каждый лист как отдельный файл для дальнейшего использования.
Примеров подобного из реальной жизни можно привести массу. Например, файл-отчет с листами-филиалами нужно разделить на отдельные книги по листам, чтобы передать затем данные в каждый филиал и т.д.
Если делать эту процедуру вручную, то придется для каждого листа выполнить немаленькую цепочку действий (выбрать лист, правой кнопкой по ярлычку листа, выбрать Копировать, указать отдельный предварительно созданный пустой файл и т.д.) Гораздо проще использовать короткий макрос, автоматизирующий эти действия.
Способ 1. Простое разделение
Нажмите сочетание Alt+F11 или выберите в меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor) , вставьте новый модуль через меню Insert - Module и скопируйте туда текст этого макроса:
Если теперь выйти из редактора Visual Basic и вернуться в Excel, а затем запустить наш макрос (Alt+F8), то все листы из текущей книги будут разбиты по отдельным новым созданным книгам.
Способ 2. Разделение с сохранением
При необходимости, можно созданные книги сразу же сохранять под именами листов. Для этого макрос придется немного изменить, добавив команду сохранения в цикл:
Этот макрос сохраняет новые книги-листы в ту же папку, где лежал исходный файл. При необходимости сохранения в другое место, замените wb.Path на свой путь в кавычках, например "D:\Отчеты\2012" и т.п.
Если нужно сохранять файлы не в стандартном формате книги Excel (xlsx), а в других (xls, xlsm, xlsb, txt и т.д.), то кроме очевидного изменения расширения на нужное, потребуется добавить еще и уточнение формата файла - параметр FileFormat:
Для основных типов файлов значения параметра FileFormat следующие:
- XLSX = 51
- XLSM = 52
- XLSB = 50
- XLS = 56
- TXT = 42
Способ 3. Сохранение в новые книги только выделенных листов
Если вы хотите раскидать по файлам не все листы в вашей книге, а только некоторые, то макрос придется немного изменить. Выделите нужные вам листы в книге, удерживая на клавиатуре клавишу Ctrl или Shift и запустите приведенный ниже макрос:
Создавать новое окно и копировать через него, а не напрямую, приходится потому, что Excel не умеет копировать группу листов, если среди них есть листы с умными таблицами. Копирование через новое окно позволяет такую проблему обойти.
Способ 4. Сохранение только выделенных листов в новый файл
Во всех описанных выше способах каждый лист сохранялся в свой отдельный файл. Если же вы хотите сохранить в отдельный новый файл сразу группу выделенных предварительно листов, то нам потребуется слегка видоизменить наш макрос:
Способ 5. Сохранение листов как отдельных PDF-файлов
- для этого используется уже другой метод (ExportAsFixedFormat а не Copy)
- листы выводятся в PDF с параметрами печати, настроенными на вкладке Разметка страницы (Page Layout)
- книга должна быть сохранена на момент экспорта
Нужный нам код будет выглядеть следующим образом:
Способ 6. Готовый макрос из надстройки PLEX
Если лень или нет времени внедрять все вышеописанное, то можно воспользоваться готовым макросом из моей надстройки PLEX:
В этой статье я хотел бы рассказать как средствами VBA переименовать, переместить или скопировать файл. В принципе методы переименования, перемещения и копирования, так сказать, встроены в VBA. Это значит что можно без вызова сторонних объектов переименовать, переместить или копировать любой файл. Все это делается при помощи всего двух команд: FileCopy и Name [Исходный файл] As [Новый файл] . Притом команда FileCopy выполняет только копирование, а Name [Исходный файл] As [Новый файл] - как переименование, так и перемещение. Разница лишь в том, что при переименовании мы указываем только новое имя файла, а при перемещении - другую директорию(папку), в которую следует переместить файл. Плюс рассмотрим пример удаления файла.
Так же разберем методы копирования, перемещения, переименования и удаления файлов и папок через библиотеку FileSystemObject (FSO).
Работа с файлами встроенными командами VBA
Работа с файлами через объект FileSystemObject (FSO)
Работа с папками через объект FileSystemObject (FSO)
Во всех примерах работы с файлами встроенными функциями будет присутствовать проверка на наличие файла по указанному пути. Делать это будем при помощи встроенной функции Dir([PathName],[Attributes]) .
PathName - указывается полный путь к файлу
Attributes - указывается признак свойств файла. Вообще их несколько(скрытый, архивный и т.п.), но нас для наших задач будет интересовать пока только один: 16(vbDirectory). Он отвечает за проверку папок и файлов без специальных свойств(т.е. не архивные, не скрытые и т.д.). Хотя по сути его можно вообще не указывать, и тогда будет по умолчанию применен атрибут 0(vbNormal) - проверка файлов без определенных свойств. Ни в том ни в другом случае ошибкой это не будет.
Sub Copy_File() Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя файла для копирования sNewFileName = "D:\WWW.xls" 'имя копируемого файла. Директория(в данном случае диск D) должна существовать If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If FileCopy sFileName, sNewFileName 'копируем файл MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru" End Sub
Sub Move_File() Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя исходного файла sNewFileName = "D:\WWW.xls" 'имя файла для перемещения. Директория(в данном случае диск D) должна существовать If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If Name sFileName As sNewFileName 'перемещаем файл MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru" End Sub
Sub Rename_File() Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя исходного файла sNewFileName = "C:\WWW1.xls" 'имя файла для переименования If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If Name sFileName As sNewFileName 'переименовываем файл MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru" End Sub
Sub Delete_File() Dim sFileName As String sFileName = "C:\WWW.xls" 'имя файла для удаления If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If Kill sFileName 'удаляем файл MsgBox "Файл удален", vbInformation, "www.excel-vba.ru" End Sub
Как видно ничего сложного.
Так же можно проделать те же операции с файлами при помощи объекта FileSystemObject. Строк кода несколько больше и выполняться операции будут медленнее(хотя вряд ли это будет заметно на примере одного файла). Однако есть существенный плюс - при помощи FileSystemObject можно корректно производить операции с файлами и папками на сетевом диске. Хотя та же Dir(sFileName, 16) часто выдает ошибку при работе с сетевыми дисками.
Прежде всего следует, я думаю, пояснить что за зверь такой - FileSystemObject.
FileSystemObject (FSO) - содержится в библиотеке типов Scripting, расположенной в файле библиотеки scrrun.dll. Объектная модель FSO дает возможность создавать, изменять, перемещать и удалять папки и файлы, собирать о них различную информацию: имена, атрибуты, даты создания или изменения и т.д. Чтобы работать с FSO необходимо создать переменную со ссылкой на объект библиотеки. Сделать это можно двумя способами: через ранее связывание и позднее. Я не буду сейчас вдаваться в подробности этих методов - тема довольно обширная и я опишу её в другой статье.
Ранее связывание: для начала необходимо подключить библиотеку Microsoft Scripting Runtime. Делается это в редакторе VBA: References-находите там Microsoft Scripting Runtime и подключаете. Объявлять переменную FSO при раннем связывании следует так:
Dim objFSO As New FileSystemObject
Плюсы раннего связывания: с помощью Object Browser можно просмотреть список объектов, свойств, методов, событий и констант, включенных в FSO. Но есть значительный минус: если планируется использовать программу на нескольких компьютерах, то есть большая вероятность получить ошибку(читать подробнее).
Позднее связывание: ничего нигде не надо подключать, а просто используем метод CreateObject(именно этот способ используется мной в примерах ниже). Методы таким образом просмотреть не получится, но зато работать будет без проблем на любых компьютерах без дополнительных действий.
Sub Copy_File() Dim objFSO As Object, objFile As Object Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя исходного файла sNewFileName = "D:\WWW.xls" 'имя файла для переименования 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие файла по указанному пути If objFSO.FileExists(sFileName) = False Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If 'копируем файл Set objFile = objFSO.GetFile(sFileName) objFile.Copy sNewFileName MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru" End Sub
Sub Move_File() Dim objFSO As Object, objFile As Object Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя исходного файла sNewFileName = "D:\WWW.xls" 'имя файла для переименования 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие файла по указанному пути If objFSO.FileExists(sFileName) = False Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If 'перемещаем файл Set objFile = objFSO.GetFile(sFileName) objFile.Move sNewFileName MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru" End Sub
Sub Rename_File() Dim objFSO As Object, objFile As Object Dim sFileName As String, sNewFileName As String sFileName = "C:\WWW.xls" 'имя исходного файла sNewFileName = "WWW1.xls" 'имя файла для переименования 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие файла по указанному пути If objFSO.FileExists(sFileName) = False Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If 'переименовываем файл Set objFile = objFSO.GetFile(sFileName) objFile.Name = sNewFileName MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru" End Sub
Хочу обратить внимание, что при переименовании файла через FileSystemObject необходимо указать только имя нового файла - путь указывать не надо. Иначе получите ошибку.
Sub Delete_File() Dim objFSO As Object, objFile As Object Dim sFileName As String sFileName = "C:\WWW.xls" 'имя файла для удаления 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие файла по указанному пути If objFSO.FileExists(sFileName) = False Then MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru" Exit Sub End If 'удаляем файл Set objFile = objFSO.GetFile(sFileName) objFile.Delete MsgBox "Файл удален", vbInformation, "www.excel-vba.ru" End Sub
Точно так же можно перемещать, копировать и удалять целые папки:
Sub Copy_Folder() Dim objFSO As Object Dim sFolderName As String, sNewFolderName As String sFolderName = "C:\test" 'имя исходной папки sNewFolderName = "D:\tmp\" 'имя папки, в которую копируем(нужен слеш на конце) 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие папки по указанному пути If objFSO.FolderExists(sFolderName) = False Then MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru" Exit Sub End If 'копируем папку objFSO.CopyFolder sFolderName, sNewFolderName MsgBox "Папка скопирована", vbInformation, "www.excel-vba.ru" End Sub
Sub Move_Folder() Dim objFSO As Object Dim sFolderName As String, sNewFolderName As String sFolderName = "C:\test" 'имя исходной папки sNewFolderName = "C:\tmp\test\" 'имя папки, в которую перемещаем(нужен слеш на конце) 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие папки по указанному пути If objFSO.FolderExists(sFolderName) = False Then MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru" Exit Sub End If 'перемещаем папку objFSO.MoveFolder sFolderName, sNewFolderName MsgBox "Папка перемещена", vbInformation, "www.excel-vba.ru" End Sub
Sub Rename_Folder() Dim objFSO As Object, objFolder As Object Dim sFolderName As String, sNewFolderName As String sFolderName = "C:\test\" 'имя исходной папки 'имя папки для переименования(только имя, без полного пути) sNewFolderName = "new folder name" 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие папки по указанному пути If objFSO.FolderExists(sFolderName) = False Then MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru" Exit Sub End If 'переименовываем папку 'получаем доступ к объекту Folder(папка) Set objFolder = objFSO.GetFolder(sFolderName) 'назначаем новое имя objFolder.Name = sNewFolderName MsgBox "Папка переименована", vbInformation, "www.excel-vba.ru" End Sub
Sub Delete_Folder() Dim objFSO As Object, objFolder As Object Dim sFolderName As String sFolderName = "C:\test\" 'имя папки для удаления 'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'проверяем наличие папки по указанному пути If objFSO.FolderExists(sFolderName) = False Then MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru" Exit Sub End If 'удаляем папку objFSO.DeleteFolder sFolderName MsgBox "Папка удалена", vbInformation, "www.excel-vba.ru" End Sub
FSO, конечно, способен на большее - но цель данной статьи была показать основные операции с папками и файлами как стандартными методами, так и более продвинутыми.
Достаточно часто появляется вопрос: как извлечь данные из закрытой книги Excel через VBA? Звучит может быть странновато, но это так: вопрос регулярно поднимается на форумах. Собственно, именно в связи с этим и появилась на свет данная статья. В принципе ничего сложного в задаче нет. При этом получить данные можно разными способами, в том числе при помощи функций пользователя(UDF).
Хотя если вдаваться в технические подробности, то получить данные из закрытой книги вообще нельзя. Так или иначе, на уровне системы файл все равно открывается, различие лишь в том как именно и к чему при этом предоставляется доступ. Поэтому переозвучим классическую постановку задачи в более распространенную в жизни: "Как получить данные из книги, не открывая её так, чтобы об этом узнал пользователь"
Попробуем разобраться с некоторыми методами, их плюсами и минусами:
Получение данных из закрытой книги при помощи процедуры VBA
Sub Get_Value_From_Close_Book_Formula() Dim sPath As String, sFile As String, sShName As String sPath = "C:\Documents and Settings\" '" sFile = "Книга1.xls" '" sShName = "Лист1" '" Application.DisplayAlerts = 0 With Range("A1:A100") .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "A1" '" '"A1" - указывается начальная ячейка диапазона, из которого необходимо получить значения .Value = .Value End With Application.DisplayAlerts = 1 End Sub
Данный код работает достаточно медленно, но с его помощью можно "вытащить" из закрытой книги значения сразу нескольких ячеек. Код ниже работает быстрее, но с его помощью можно извлечь значения лишь одной ячейки:
Sub Get_Value_From_Close_Book_Excel4Macro() Dim sPath As String, sFile As String, sShName As String Dim sAddress As String, vData sPath = "C:\Documents and Settings\" '" sFile = "Книга1.xls" '" sShName = "Лист1" '" sAddress = "'" & sPath & "[" & sFile & "]" & sShName & "'!" & Range("A1").Address(ReferenceStyle:=xlR1C1) '" vData = ExecuteExcel4Macro(sAddress) End Sub
Если честно, сам я не очень-то люблю ни один из данных методов, т.к. они совершенно лишены гибкости. С их помощью можно получить исключительно значения ячеек. Форматы, формулы или другие свойства ячеек получить уже не получится. Поэтому я предпочитаю открывать книгу и копировать то, что мне надо. Делаю это, скрывая от пользователя при помощи свойства ScreenUpdating объекта Application.
Sub Get_Value_From_Close_Book() Dim sShName As String, sAddress As String, vData Dim objCloseBook As Workbook 'Отключаем обновление экрана Application.ScreenUpdating = False Set objCloseBook = Workbooks.Open("C:\Documents and Settings\Книга1.xls") sAddress = "A1:C100" 'или одна ячейка - "A1" 'получаем значение vData = Sheets("Лист1").Range(sAddress).Value 'Записываем данные на активный лист книги, 'с которой запустили макрос If IsArray(vData) Then [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData Else [A1] = vData End If 'если надо копировать ячейки с форматами, 'то можно использовать стандартные методы копирования вставки 'objCloseBook.Sheets("Лист1").Range(sAddress).Copy '[A1].PasteSpecial xlPasteValues 'вставляем значения '[A1].PasteSpecial xlPasteFormats 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
Есть и более экзотический метод - при помощи GetObject:
Sub Get_Value_From_Close_Book2() Dim sShName As String, sAddress As String, vData Dim objCloseBook As Object 'Отключаем обновление экрана Application.ScreenUpdating = False Set objCloseBook = GetObject("C:\Documents and Settings\Книга1.xls") sAddress = "A1:C100" 'или одна ячейка - "A1" 'получаем значение vData = objCloseBook.Sheets("Лист1").Range(sAddress).Value 'Записываем данные на активный лист книги, 'с которой запустили макрос If IsArray(vData) Then [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData Else [A1] = vData End If 'если надо копировать ячейки с форматами, 'то можно использовать стандартные методы копирования вставки 'objCloseBook.Sheets("Лист1").Range(sAddress).Copy '[A1].PasteSpecial xlPasteValues 'вставляем значения '[A1].PasteSpecial xlPasteFormats 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
При таком подходе пользователь разницы не увидит, а действия можно производить с ячейками разные: и сравнение, и отбор по критериям, и фильтровать, и сортировать и т.д. Плюс из книги можно переносить не только значения ячеек, но и форматы, формулы. Но выбирать метод получения значений из закрытых книг вам. Все зависит от ситуации. Все указанные коды работают. Если не работают - то проверьте верно ли указаны все исходные данные(имя книги и расширение, имя листа, путь к папке с книгой).
Получение данных из закрытой книги при помощи UDF
Тот же код, что уже был рассмотрен выше, но оформленный в виде UDF(функции пользователя):
Function Get_Value_From_Close_Book(sWb As String, sShName As String, sAddress As String) Dim vData, objCloseBook As Object Set objCloseBook = GetObject(sWb) 'получаем значение vData = objCloseBook.Sheets(sShName).Range(sAddress).Value objCloseBook.Close False Set objCloseBook = Nothing 'Возвращаем данные в ячейку с функцией Get_Value_From_Close_Book = vData End Function
Синтаксис функции (вызов с листа):
=Get_Value_From_Close_Book("C:\Книга1.xls";"Лист1";"B1")
sWb - полный путь до книги, данные из которой необходимо извлечь ( "C:\Книга1.xls" )
sShName - имя листа в указанной книге, данные из которого необходимо извлечь ( "Лист1" )
sAddress - адрес ячейки(диапазона) данные которой необходимо получить ( "B1" )
Чтобы получить массив ячеек(например B1:B10), необходимо выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.
Думаю, не надо пояснять, что любой аргумент может быть задан не статичным текстом, а ссылкой на ячейку с этим текстом. Именно в этом и преимущество использования именно функций, а не процедур.
ПОЛУЧЕНИЕ ДАННЫХ ПРИ ПОМОЩИ ЗАПРОСА ADO
Так же есть еще один достаточно экзотический метод получения данных из действительно закрытой книги - через ADO(ActiveX Data Objects). По сути это получение данных через запрос SQL, используя для этого технологию ADO.
'--------------------------------------------------------------------------------------- ' Procedure : Extract_Value_ADO ' DateTime : 02.07.2014 16:47 ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция получения данных из закрытой книги при помощи ADO ' в таком виде не может быть использована вызовом с листа '--------------------------------------------------------------------------------------- Function Extract_Value_ADO(sPath As String, sFileName As String, sShName As String, sRng As String) Dim objADO_Con As Object, objRS As Object Dim sFullFileName As String, sADORng As String 'проверяем наличие слеша в пути к файлу If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO If Range(sRng).Count = 1 Then sADORng = sRng & ":" & sRng Else sADORng = sRng End If sFullFileName = sPath & sFileName With CreateObject("ADODB.Connection") 'подключаемся к файлу .Open "Driver=;ReadOnly=1;DBQ=" & sFullFileName & ";" 'извлекаем записи из указанного диапазона в objRS Set objRS = .Execute("select * FROM [" & sShName & "$" & sADORng & "]") 'выгружаем извлеченные данные на активный лист, начиная с ячейки А1 Cells(1, 1).CopyFromRecordset objRS 'Extract_Value_ADO = objRS.Fields(0).Value End With Set objRS = Nothing End Function
Вызывать эту функцию следует из другой процедуры или функции. Пример процедуры, для вызова этой функции:
Для вызова функции Extract_Value_ADO непосредственно с листа(в виде функции UDF) придется несколько изменить приведенный выше код функции, либо извлекать функцией значение только одной ячейки, что будет не очень экономично с точки зрения ресурсов и использование для этого ADO будет слишком неоправданным. Если кому необходимо, то для вызова функции с ячейки листа и возврата значения одной ячейки, необходимо заменить строку:
Cells(1, 1).CopyFromRecordset objRS
Синтаксис вызова с листа в таком случае будет следующим:
=Extract_Value_ADO("C:\"; "Книга1.xls"; "Лист1"; "A1")
Важно: если данные извлекаются только из одной ячейки, то следует указать две ячейки: А1:А2 . Это особенность работы с запросами
Если же необходимо извлекать данные диапазона ячеек, то в этом случае можно применить такую функцию:
'--------------------------------------------------------------------------------------- ' Procedure : Extract_Value_ADO ' DateTime : 02.07.2014 16:47 ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция получения данных из закрытой книги при помощи ADO ' вызывается с листа как функция массива(если получаем данные с диапазона) '--------------------------------------------------------------------------------------- Function Extract_Value_ADO_Sh(sPath As String, sFileName As String, sShName As String, sRng As String) Dim objADO_Con As Object, objRS As Object Dim sFullFileName As String, sADORng As String Dim avTmp(), avRes(), li As Long, lr As Long, lc As Long 'проверяем наличие слеша в пути к файлу If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO If Range(sRng).Count = 1 Then sADORng = sRng & ":" & sRng Else sADORng = sRng End If sFullFileName = sPath & sFileName With CreateObject("ADODB.Connection") 'подключаемся к файлу .Open "Driver=;ReadOnly=1;DBQ=" & sFullFileName & ";" 'получаем кол-во строк в запросе Set objRS = .Execute("SELECT COUNT(*) FROM [" & sShName & "$" & sADORng & "]") li = objRS.Fields(0).Value 'извлекаем записи из указанного диапазона в objRS Set objRS = .Execute("SELECT * FROM [" & sShName & "$" & sADORng & "]") 'выгружаем извлеченные данные на активный лист, начиная с ячейки А1 ReDim avRes(1 To li, 1 To objRS.Fields.Count) avTmp = objRS.getrows(li, 0) 'получаем массив данных запроса For lr = 0 To li - 1 'цикл по строкам For lc = 0 To UBound(avTmp, 1) 'цикл по столбцам 'значения Null не допускаются, поэтому приходится их подменять до выгрузки на лист If IsNull(avTmp(lc, lr)) Then avTmp(lc, lr) = Empty End If avRes(lr + 1, lc + 1) = avTmp(lc, lr) Next lc Next lr End With Extract_Value_ADO_Sh = avRes Set objRS = Nothing End Function
Синтаксис вызова с листа точно такой же как и в функции выше, только нужно будет выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.:
=Extract_Value_ADO_Sh("C:\"; "Книга1.xls"; "Лист1"; "A1:B10")
sPath - путь к папке с книгой, данные из которой необходимо извлечь ( "C:\" )
sWb - имя книги, включая расширение(.xls в примере), данные из которой необходимо извлечь ( "Книга1.xls" )
sShName - имя листа в указанной книге, данные из которого необходимо извлечь ( "Лист1" )
sAddress - адрес ячейки(диапазона) данные которой необходимо получить ( "A1" )
Важно: если данные извлекаются только из одной строки, то следует все равно указать минимум две строки: А1:B10 . Это особенность работы с запросами. При попытке указать только одну строку А1:A10 функция вернет значение ошибки. При этом первая строка воспринимается как заголовки. Т.е. данные должны начинаться как минимум со второй строк(A2), а в A1 - заголовок
Хоть эта функция имеет определенные недостатки - она может быть в разы быстрее предыдущей.
Получение данных из закрытой книги при помощи Power Query
Если еще не работали с надстройкой PowerQuery и не знаете что это такое, то для начала лучше ознакомиться со статьей: Power Query - что такое и почему её необходимо использовать в работе?
Переходим на вкладку Данные(для Excel ниже 2016 вкладка PowerQuery) -Получить данные -Из файла -Из книги
Выбираем нужный лист
Если необходимы данные всего листа, то внизу этого окна нажимаем кнопку Загрузить. Все, через пару секунд все данные выбранного листа будут помещены на новый лист текущей книги в умную таблицу.
Читайте также: