Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как сменить формат сразу для нескольких файлов Excel

Наверняка многие сталкивались с такой проблемой, что некоторые программы и макросы позволяют работать исключительно с определенными форматами файлов. А в жизни далеко не всегда все файлы в одном формате. Например, модная в последнее время надстройка PowerQuery неравнодушна к файлам xlsb - с ними она порой отказывается нормально работать и предпочитает им более открытые форматы xlsx и xslm.
Решил набросать небольшой практический код, который пересохраняет все файлы в указанной папке в один формат, что избавит от ручной работы в виде открывания и сохранения каждого файла в нужный формат.

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
' Purpose:
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub SaveAs_Mass()
    Dim sFolder As String, sFiles As String, sNonEx As String, sNewEx As String
    Dim wb As Workbook
    Dim lPos As Long, lFileFormat As Long, IsDelOriginal As Boolean
 
    'указываем новый формат файлов
    sNewEx = InputBox("Укажите новое расширение для файлов:", "www.excel-vba.ru", "xlsx")
    'определяем числовой код формата файлов
    Select Case sNewEx
        Case "xlt": lFileFormat = 17
        Case "xla": lFileFormat = 18
        Case "xlsb": lFileFormat = 50
        Case "xlsx": lFileFormat = 51
        Case "xlsm": lFileFormat = 52
        Case "xltm": lFileFormat = 53
        Case "xltx": lFileFormat = 54
        Case "xlam": lFileFormat = 55
        Case "xls": lFileFormat = 56
        'если указанный формат не соответсвует ни одному из существующих
        Case Else
            MsgBox "Формат '" & sNewEx & "' не поддерживается", vbCritical, "www.excel-vba.ru"
            Exit Sub
    End Select
 
    '   если надо просматривать файлы в той же папке, что и файл с кодом:
    '       sFolder = ThisWorkbook.Path
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'запрашиваем - удалять ли исходные файлы после сохранения в новом формате
    IsDelOriginal = MsgBox("Удалять исходные файлы после пересохранения?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes
    'отключаем обновление экрана и показ системных сообщений
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    'просматриваем все файлы Excel в выбранной папке
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        If sFiles <> ThisWorkbook.Name Then
            'получаем имя файла без расширения
            lPos = InStrRev(sFiles, ".")
            sNonEx = Mid(sFiles, 1, lPos)
            'открываем книгу
            Set wb = Application.Workbooks.Open(sFolder & sFiles, False)
            'сохраняем в новом формате и закрываем
            wb.SaveAs sFolder & sNonEx & sNewEx, lFileFormat
            wb.Close 0
            DoEvents
            'если надо удалить исходные файлы после преобразования
            If IsDelOriginal Then
                On Error Resume Next
                Kill sFolder & sFiles
                DoEvents
                On Error GoTo 0
            End If
        End If
        sFiles = Dir
    Loop
    'возвращаем обновление экрана и показ системных сообщений
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = 1
    MsgBox "Файлы преобразованы", vbInformation, "www.excel-vba.ru"
End Sub

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, в Excel переходим в редактор VBA(Alt+F11) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -SaveAs_Mass -Выполнить(Run).
Все, что будет необходимо это указать один из форматов и выбрать папку с файлами, для пересохранения. В папке может находится и сам файл с кодом, но он не будет затронут.
Основные запросы и настройки кода:

  • Первым появляется запрос формата файлов(Укажите новое расширение для файлов:) - здесь надо указать формат, который будет назначен выбранным файлам после выполнения команды. Доступные форматы:
      1. xlsx - книга Excel без поддержки макросов. При сохранении в данный формат книг, содержащих макросы, все макросы будут удалены автоматически. Если необходимо сохранить макросы следует выбрать формат - xlsm.
      2. xlsm - книга Excel с поддержкой макросов
      3. xlsb - двоичная книга Excel (с поддержкой макросов)
      4. xlam - надстройка Excel (с поддержкой макросов)
      5. xltx - шаблон Excel (без поддержки макросов)
      6. xltm - шаблон Excel с поддержкой макросов
      7. xls - книга Excel (97-2003)
      8. xla - надстройка Excel (97-2003)
      9. xlt - шаблон Excel (97-2003)

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

  • Далее появляется запрос указать папку с файлами, которые надо пересохранить.
  • И последний запрос - "Удалять исходные файлы после пересохранения?". Если выбрать да, то после сохранения каждого файла в папке в нужный формат его исходник будет удален. Следует осторожно использовать эту опцию, т.к. удаление файлов происходит без возможности восстановления. Особенно это критично, если пересохранение идет либо в формат xslx, при котором удаляются все макросы из файла, либо при сохранении в устаревший формат xls, который поддерживает не более 65536 строк данных и 256 столбцов. Если какие-то файлы при этом ранее были в более новом формате и содержали большее количество строк или столбцов, то данные будут утеряны(сохранится только 65536 строк и 256 столбцов).

Небольшой практический совет: приложенный код можно применить для удаления макросов из всех указанных книг. Все книги, макросы в которых необходимо удалить, помещаются в одну папку. Далее запускается код и указывается формат "xlsx". Все файлы будут сохранены в этом формате. После этого можно будет файлы пересохранить и в иной формат(xls, например). Но макросов там уже точно не будет.

Изменение формата приведенным кодом возможно только для файлов Excel и не может быть использовано для изменения форматов файлов других программ(OpenOffice, Paint и т.п.).

Скачать пример:

  Сменить формат файлов.xslm (29,8 KiB, 1 168 скачиваний)

Так же см.:
Просмотреть все файлы в папке
Как удалить макросы в книге?
Сменить формат файлов


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 11 комментариев
  1. azma:

    Отлично!Будет очень круто, если можно сделать так, чтобы не писать формат вручную, а выбрать(из выпадающего списка).

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

  2. azma:

    уважаемый Дмитрий, здравствуйте!
    я заметил что если нужно менять формат с xlam на xlsx то формат не меняется.
    для этого нужно менять строку
    sFiles = Dir(sFolder & "*.xls*")
    на
    sFiles = Dir(sFolder & "*.xl*")

  3. Олег:

    Подскажите, как сделать так, чтобы подпапки тоже затрагивало? Спасибо.

  4. Большое спасибо за код!
    Подскажите, можно ли добавить к названию пересоханенных файлов текущую дату?

    Подойдет ли такой вариант, и куда его вставить?
    r = Format(Now(), "yymmdd")
    имя файла -> " & r & "_продажи"

    • Ирина, в коде вроде все важные строки прокомментированы :) Находите эти строки:
      'сохраняем в новом формате и закрываем
      wb.SaveAs sFolder & sNonEx & sNewEx, lFileFormat

      и меняете соответственно имя:
      'сохраняем в новом формате и закрываем
      r = Format(Now(), "yymmdd")
      wb.SaveAs sFolder & sNonEx & r & "_продажи" & sNewEx, lFileFormat

  5. Дмитрий:

    Дмитрий, здравствуйте,

    попробовал Ваш код для преобразование файла формата csv в xlsx.
    В исходном файле много строк. В каждой строке значения разделены ;
    В полученном файл все значения каждой строки получились записанными не в несколько ячеек, а в одну в столбце А.
    Что можно сделать?
    Спасибо.

    • Дмитрий, так в статье про CSV речи не идет - там про файлы Excel. А CSV это по сути текстовый файл и открытие иначе должно происходить - через OpenText. В котором есть параметр Local и его надо установить в True. Тогда, возможно, открывать файл будет с корректными разделителями и как следствие сохранять правильно. Запишите макрорекордером открытие файла CSV и для параметра Local задайте True.
      Плюс непонятно про "много строк разделены ;" - может столбцы, а не строки? :)

  6. Ksenia 112233:

    Добрый день, сделал все согласно инструкции, макрос отработал и написал файлы преобразованы, но по факту все файлы с макросами остались с макросами

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

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти