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, которые находятся в одной папке (не открывая сами файлы) Спасибо.
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
Не уверен, что вы получили ответ на свой вопрос, поэтому покажу вам свой вариант
Код
Код
Option Explicit
'====================================================================================================
Sub OpenAllFilesAndFixActiveSheet()
Dim sh As Worksheet
Dim iPath, aPath()
aPath = Array("C:\folder\file1.xlsx", "C:\folder\file2.xlsx", "C:\folder\file3.xlsx") ' массив полных имён/путей к файлам
For Each iPath In aPath ' цикл по всем путям (файлам) массива
Workbooks.Open FileName:=iPath, UpdateLinks:=False, ReadOnly:=False ' открываем файл
Set sh = ActiveSheet ' можно закоментировать или удалить (но можно оставить), если используем цикл по листам
For Each sh In ActiveWorkbook.Worksheets ' /// цикл по всем листам книги. Закоментировать или удалить эту и закрывающую цикл строки, если нужно работать только с одним активным (на момент открытия файла) листом
With sh.UsedRange ' работаем с листом
.NumberFormat = "@"
.Value = .Value
.NumberFormat = "General"
End With
Next sh ' /// строка, закрывающая цикл по всем листам
ActiveWorkbook.Close SaveChanges:=True ' закрываем файл
Next iPath
End Sub
'====================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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