Страницы: 1
RSS
Применить макрос ко всем файлам папки
 
Код
Sub FixActiveSheet()
    FixSheet ActiveSheet
End Sub
 
Sub FixSheet(sh As Worksheet)
    With sh.UsedRange
        .NumberFormat = "@"
        Dim arr As Variant
        arr = .Value
        .Value = arr
        .NumberFormat = "General"
    End With
End Sub
Здравствуйте уважаемые форумчане, подскажите как можно макрос применить сразу к нескольким файлам excel, которые находятся в одной папке (не открывая сами файлы) Спасибо.
Изменено: vikttur - 14.01.2022 13:31:00
 
не открывая - никак
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Хорошо! Если открыть все эти файлы, как запустить макрос сразу ко всем открытым файлам?
 
сразу ко всем - никак
последовательно к каждому - элементарно

вообще см. #2, ответ исчерпывающий, тему на этом можно считать закрытой
вопрос: как?
ответ: никак!
что еще обсуждать в этой теме?
Изменено: Ігор Гончаренко - 13.01.2022 20:26:22
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Вам нужно писать совершенно другую процедуру, а лучше сразу VSTO.
 
Да, посмотрел уже, тема закрытп!  
 
Код
Option Explicit

Sub FixFiles()
    Dim arrFiles As Variant
    arrFiles = ShowFileDialog()
    If IsEmpty(arrFiles) Then Exit Sub
    Dim wb As Workbook
    Dim vFile As Variant
    For Each vFile In arrFiles
        Set wb = Workbooks.Open(vFile)
        FixFile wb
        wb.Close True
    Next
End Sub

Sub FixFile(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        FixSheet sh
    Next
End Sub

Sub FixSheet(sh As Worksheet)
    With sh.UsedRange
        .NumberFormat = "@"
        Dim arr As Variant
        arr = .Value
        .Value = arr
        .NumberFormat = "General"
    End With
End Sub

Function ShowFileDialog() As Variant
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path & "\" 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        Dim arr As Variant
        ReDim arr(1 To .SelectedItems.Count)
        For lf = 1 To .SelectedItems.Count
            arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
        Next
    End With
    ShowFileDialog = arr
End Function
 
Цитата
Артём Москвитин: Да, посмотрел уже, тема закрыта!
Не уверен, что вы получили ответ на свой вопрос, поэтому покажу вам свой вариант
Код
Изменено: Jack Famous - 14.01.2022 10:26:19
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Вот код для надстройки VSTO.

Скрытый текст
Изменено: Иван Манченко - 15.01.2022 15:13:57
 
МатросНаЗебре, макрос вселяет надежды, но почему то не удаляет апострофы и лишние знаки, а наоборот добавляет их на лист!
 
Код
Option Explicit

Public fso As Object

Sub FixFiles()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim arrFiles As Variant
    arrFiles = ShowFileDialog()
    If IsEmpty(arrFiles) Then Exit Sub
    Dim wb As Workbook
    Dim vFile As Variant
    For Each vFile In arrFiles
        If fso.GetExtensionName(vFile) = "csv" Then
            FixCSVFile vFile
        Else
            Set wb = Workbooks.Open(vFile)
            FixFile wb
            wb.Close True
        End If
    Next
End Sub

Sub FixCSVFile(ByVal sFull As String)
    Dim txt As String
    With fso.OpenTextFile(sFull, 1)
        txt = .ReadAll
        .Close
    End With
    
    Dim v As Variant
    For Each v In Array("=", """")
        txt = Replace(txt, v, "")
    Next

    With fso.OpenTextFile(sFull, 2)
        .Write txt
        .Close
    End With
End Sub
 
Sub FixFile(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        FixSheet sh
    Next
End Sub
 
Sub FixSheet(sh As Worksheet)
    With sh.UsedRange
        .NumberFormat = "@"
        Dim arr As Variant
        arr = .Value
        .Value = arr
        .NumberFormat = "General"
    End With
End Sub
 
Function ShowFileDialog() As Variant
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.csv", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path & "\" 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        Dim arr As Variant
        ReDim arr(1 To .SelectedItems.Count)
        For lf = 1 To .SelectedItems.Count
            arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
        Next
    End With
    ShowFileDialog = arr
End Function
 
Спасибо Большое!
Страницы: 1
Наверх