Конвертируем xls в dbf с помощью макросов

Количество просмотров: 594

Условие: Имеются несколько файлов в табличном редакторе Excel. Используя макросы, необходимо сделать книгу в формате DBF из различных листов этих файлов, т.е. должен предполагаться выбор этих листов.

Решение:

Начиная с MS Excel 2007, поддержка формата *.dbf была прекращена. Для конвертации необходимо использовать сторонние надстройки. В статье рассмотрим сохранение в формат *.dbf на примере MS Excel 2003.

Для начала выбираем в панели инструментов панель с формами: Вид->Панель инструментов->Формы. Выбираем элемент "кнопка", далее необходимо в диалоговом окне назначить кнопке макрос. Для этого выбираем Создать.

Теперь мы можем приступить к написанию макроса.

Для создания диалогового окна используем метод Application.GetOpenFilename.

Application.GetOpenFilename([FileFilter], [FilterIndex], [Title], [ButtonText], [MultiSelect])

Параметры:
  • FileFilter Строка, указывающая условия фильтрации файлов. Здесь указываем тип файлов, которые будут отображаться в диалоговом окне выбора. Например, при указании "Excel files(*.xls*),*.xls*" можно будет выбрать только файлы Excel. Если указать "Text files(*.txt),*.txt", то можно будет выбрать только текстовые файлы с расширением .txt. Так же можно указать выбор нескольких типов файлов или любых типов файлов: "All files(*.*),*.*"
  • FilterIndex Указывает значения индексов условий фильтрации файлов по умолчанию — от 1 до количества фильтров, указанных в FileFilter. Если этот аргумент пропущен или его значение превышает число имеющихся фильтров, используется первый фильтр файлов.
  • Title Указывает заголовок диалогового окна. Если этот аргумент пропущен, используется заголовок Открыть.
  • ButtonText Используется только на Mac.
  • MultiSelect Если установлено значение True, можно выбрать несколько имен файлов, а если установлено значение False, можно выбрать только одно имя файла. По умолчанию используется значение False.

 If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If

В случае нажатия кнопка Отмена выходим из процедуры. Если параметру MultiSelect присвоено значение False, то переменная avFiles примет тип String, т.е. это будет одна строка. Если же параметр MultiSelect равен True, то переменная avFiles примет тип Array - массив строк, в котором будут записаны все пути и имена выбранных файлов.

  
 For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
            Fn = Left$(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
            sSheetName = InputBox("Ââåäèòå èìÿ ëèñòà", "Ïàðàìåòð")
            p = Split(sSheetName, ",")
            For i = 0 To UBound(p)
                number = p(i)
                Workbooks(Fn).Sheets(number).Copy _
                After:=Workbooks(Wname).Sheets(Workbooks(Wname).Sheets.count)
                count = Workbooks(Wname).Sheets.count
                Sheets(count).Name = "Лист" & count
            Next i
            Workbooks(Fn).Close
        Else
            Set wbAct = ThisWorkbook
        End If
    Next li
    

С помощью LBound и UBound определяем условия для выполнения цикла.Если bPolyBooks равно 1, то мы извлекаем из avFiles первый элемент, содержащий название первой выбранной книги, и открываем ее. Получаем имя активной книги и сохраняем значение в переменную Fn.

  For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
            Fn = Left$(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)

        ...

    Next li
    

Далее инициализируем диалоговое окно для ввода номеров листов соответствующей книги. Введенная строка разбивается по символу "," и элементы сохраняются в массив p. Далее перебираем номера выбранных листов в цикле и копируем содержимое в конец активной книги. Присваиваем вновь созданному листу имя "Лист" & count, содержащее его номер.


            ...

            sSheetName = InputBox("Введите имя листа", "Параметр")
            p = Split(sSheetName, ",")
            For i = 0 To UBound(p)
                number = p(i)
                Workbooks(Fn).Sheets(number).Copy _
                After:=Workbooks(Wname).Sheets(Workbooks(Wname).Sheets.count)
                count = Workbooks(Wname).Sheets.count
                Sheets(count).Name = "Лист" & count
            Next i

            ...

    

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


 For Each x In ThisWorkbook.Worksheets
        lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.count - 1
        
        For i = 1 To lLastRow
            Range("A1:C" & lLastRow).Select
            Range("A1:C" & lLastRow).EntireColumn.AutoFit
        Next i
    Next x

Проходя по всем листам активной книги, выделяем диапазон, создаем книгу с копируемым листом и сохраняем в формате *.dbf.



For Each s In wb.Worksheets      'проходим во всем листам активной книги
       
      Range("A1:C2").Select
      s.Copy
       ActiveWorkbook.SaveAs Filename:= _
        "pmp_" & s.Name & ".dbf", FileFormat:= _
        xlDBF4, CreateBackup:=False
        Application.DisplayAlerts = False
        ActiveWorkbook.Save
        ActiveWorkbook.Close
          Application.DisplayAlerts = True
   Next s

Исходник

Книга с макросом

© 2015-2018 Goodweb.me --- Карта сайта --- info@goodweb.me

Наверх