Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос не видит файлы с расширением xlsx - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос не видит файлы с расширением xlsx (Макросы/Sub)
Макрос не видит файлы с расширением xlsx
Mark1976 Дата: Пятница, 22.04.2016, 22:46 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Всем привет. Есть макрос. Но есть проблема, макрос не видит файлы с расширением xlsx. Можете это исправить. Мне надо, чтобы макрос работал как с файлами xls так и с файлами xlsx. Буду признателен.
[vba]
Код
Sub Сбор_листов_в_один_файл()
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
i As Integer, stbar As Boolean
On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application 'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
.ScreenUpdating = False
stbar = .DisplayStatusBar
.DisplayStatusBar = True
.DisplayAlerts = False
For i = 1 To UBound(arFiles)
.StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
For Each shSrc In wbSrc.Worksheets
If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
Set shTarget = wbTarget.Sheets.Add(after:=wbTarget.Sheets(wbTarget.Sheets.Count))
shTarget.Name = shSrc.Name & "-" & i
shSrc.Cells.Copy shTarget.Range("A1")
End If
Next
wbSrc.Close False 'закрыть без запроса на сохранение
Next
.ScreenUpdating = True
.DisplayStatusBar = stbar
.StatusBar = False
If wbTarget.Sheets.Count = 1 Then 'не добавлено ни одного листа
MsgBox "В указанных книгах нет непустых листов, сохранять нечего!"
wbTarget.Close False
End
Else
.DisplayAlerts = False
wbTarget.Sheets(1).Delete
.DisplayAlerts = True
End If
On Error Resume Next 'если указанный путь не существует и его не удается создать,
'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
[/vba]
 
Ответить
СообщениеВсем привет. Есть макрос. Но есть проблема, макрос не видит файлы с расширением xlsx. Можете это исправить. Мне надо, чтобы макрос работал как с файлами xls так и с файлами xlsx. Буду признателен.
[vba]
Код
Sub Сбор_листов_в_один_файл()
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
i As Integer, stbar As Boolean
On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application 'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
.ScreenUpdating = False
stbar = .DisplayStatusBar
.DisplayStatusBar = True
.DisplayAlerts = False
For i = 1 To UBound(arFiles)
.StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
For Each shSrc In wbSrc.Worksheets
If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой
Set shTarget = wbTarget.Sheets.Add(after:=wbTarget.Sheets(wbTarget.Sheets.Count))
shTarget.Name = shSrc.Name & "-" & i
shSrc.Cells.Copy shTarget.Range("A1")
End If
Next
wbSrc.Close False 'закрыть без запроса на сохранение
Next
.ScreenUpdating = True
.DisplayStatusBar = stbar
.StatusBar = False
If wbTarget.Sheets.Count = 1 Then 'не добавлено ни одного листа
MsgBox "В указанных книгах нет непустых листов, сохранять нечего!"
wbTarget.Close False
End
Else
.DisplayAlerts = False
wbTarget.Sheets(1).Delete
.DisplayAlerts = True
End If
On Error Resume Next 'если указанный путь не существует и его не удается создать,
'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
[/vba]

Автор - Mark1976
Дата добавления - 22.04.2016 в 22:46
_Boroda_ Дата: Пятница, 22.04.2016, 22:58 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 9369
Репутация: 3942 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
arFiles = .GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Объединить файлы", , True)
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
arFiles = .GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Объединить файлы", , True)
[/vba]

Автор - _Boroda_
Дата добавления - 22.04.2016 в 22:58
Mark1976 Дата: Пятница, 22.04.2016, 23:00 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
_Boroda_, вроде строки одинаковые.
[moder]Звездочки после xls


Сообщение отредактировал _Boroda_ - Пятница, 22.04.2016, 23:01
 
Ответить
Сообщение_Boroda_, вроде строки одинаковые.
[moder]Звездочки после xls

Автор - Mark1976
Дата добавления - 22.04.2016 в 23:00
Mark1976 Дата: Пятница, 22.04.2016, 23:13 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
_Boroda_, не заметил. Спасибо. Да, все работает.
 
Ответить
Сообщение_Boroda_, не заметил. Спасибо. Да, все работает.

Автор - Mark1976
Дата добавления - 22.04.2016 в 23:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос не видит файлы с расширением xlsx (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!