Здравтсвуйте! Прошу помощи, в вопросе того, что макрос обращается к файлу с расширением .xlsm, хотя в коде я явно указал, что работаем с расширением .xls и по идее расширение .xlsm ДОЛЖЕН пропускать, но почему-то такого нет, сама часть кода выглядит так:
Код
Sub Main(control As Office.IRibbonControl)
Dim avFiles, sPath As String, li As Long, le As Long, lr As Long, lc As Long
.................
avFiles = Dir(sPath & "*.xls") -вот тут задал расширение
но далее все-равно открывает файл c расширением *.xlsm, почему не пропускает его? как избежать открытия ненужного расширения?? как его задать ещё? проблема, как я понимаю, что макрос в этом месте работает с любым расширением: Do While avFiles <> ""... как можно уточнить расширение?
Есть такая беда с Dir - берет только первую часть расширения. Поэтому единственный вариант это дополнительно сравнивать расширение файла уже внутри цикла.
Вы прям помните??? это было в 13 году,- как можно помнить!!?? столько времени прошло, не реально же...... -я через два дня как в первый раз смотрю на код.....
Предположу, что первыми просматриваются сейчас файлы xls, поэтому все и работает. Но если вдруг где в середине просмотра попадется файл не xls - цикл завершится, просмотрев НЕ ВСЕ. Поверьте на слово или проверьте, добавив в папку файлы xlsx в такими же именами или именами, которые будут при помощи Dir просматриваться ПЕРВЫМИ(до файлов xls).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Дмитрий(The_Prist) Щербаков, теперь понятно,- вы правы,- так и есть, останавливается(хотя расширение xlsx я не использую); но, проблема в том что не могу ваше условие поставить в код: либо зависает, либо ругается на отсутствие "Do" может подсткажете куда вставить ваше условие? сам код вот он:
Код
спецификация:
Do While Right(LCase(avFiles), 4) = ".xls" ' зе пирст дал
'Do While avFiles <> "" - оригинал
'Do While LCase(avFiles) Like "*.xls" - это я мастырил
'====================================
'Правильнее будет после этой строки
'Do While avFiles <> ""
'добавить условие
'If Right(LCase(avFiles), 4) = ".xls" Then
'обработка файла
'End If
'======================================
If sActWB <> avFiles Then
Workbooks.Open sPath & avFiles, False
End If
bCnt = False
With Sheets(sShName1)
avArr = .UsedRange.Value
'Итоги по суммам
lc = Find_Col(avArr, sFndStr)
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row + 1
For li = 5 To 1 Step -1
If li = 1 And avArr(lr, lc - alStep(li - 1)) = 0 Then
bCnt = True
Else
adblSums(li) = adblSums(li) + avArr(lr, lc - alStep(li - 1))
End If
Next li
'Итоги по Кол-во мест:
lc = Find_Col(avArr, sFndCntStr) + 1
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row
If bCnt Then
adblSums(1) = adblSums(1) + avArr(lr, lc) + avArr(lr, lc + 1)
Else
dblCntSum = dblCntSum + avArr(lr, lc) + avArr(lr, lc + 1)
End If
End With
If sActWB <> avFiles Then ActiveWorkbook.Close 0
avFiles = Dir
Loop
'подводим суммы в текущем файле
With Workbooks(sActWB).Sheets(sShName1)
avArr = .UsedRange.Value
'заносим результаты суммирования на лист
lc = Find_Col(avArr, sFndStr)
lr = .Cells(.Rows.Count, lc).End(xlUp).Row + lRowsCnt_UnderLastRow
For li = 1 To 5
With .Cells(lr, lc - alStep(li - 1))
.Value = adblSums(li)
.EntireColumn.AutoFit
.Borders.Color = -4165632: .Borders.Weight = xlThin
.Interior.Color = 12040422
If li < 3 Then .NumberFormat = ""
End With
Next li
With .Cells(lr, lc - alStep(0)).Offset(, -3).Resize(, 13)
.Font.ColorIndex = 3: .Font.Size = 18: .Font.Bold = True
End With
With .Cells(lr, lc - alStep(0)).Offset(, -3)
.Value = "сумма инвойсов:"
End With
'lc = Find_Col(avArr, sFndCntStr) + 1
' lc1 = Find_Col(avArr, sFndCntStr) - 3
' lc = "сумма инвойсов"
' With .Cells(lr, lc)
' .Value = dblCntSum
' .EntireColumn.AutoFit: .NumberFormat = ""
' .Borders.Color = -4165632: .Borders.Weight = xlThin
' .Interior.Color = 12040422
' End With
End With
Call Check.Main
'11. Прокрутка экрана к концу талбицы:
prokrutka
Application.ScreenUpdating = 1
End Sub
If right(lcase(avFiles),4) = ".xls" then 'обработка файла end if
Разницу улавливаете между заменить и записать после? Т.е. цикл так и должен был остаться:
Код
Do While avFiles <> ""
'а тут добавляем проверку, что файл с нужным расширением
If Right(LCase(avFiles), 4) = ".xls" Then
If sActWB <> avFiles Then
Workbooks.Open sPath & avFiles, False
End If
bCnt = False
With Sheets(sShName1)
avArr = .UsedRange.Value
'Итоги по суммам
lc = Find_Col(avArr, sFndStr)
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row + 1
For li = 5 To 1 Step -1
If li = 1 And avArr(lr, lc - alStep(li - 1)) = 0 Then
bCnt = True
Else
adblSums(li) = adblSums(li) + avArr(lr, lc - alStep(li - 1))
End If
Next li
'Итоги по Кол-во мест:
lc = Find_Col(avArr, sFndCntStr) + 1
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row
If bCnt Then
adblSums(1) = adblSums(1) + avArr(lr, lc) + avArr(lr, lc + 1)
Else
dblCntSum = dblCntSum + avArr(lr, lc) + avArr(lr, lc + 1)
End If
End With
If sActWB <> avFiles Then ActiveWorkbook.Close 0
avFiles = Dir
End If'If Right(LCase(avFiles), 4) = ".xls"
Loop
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
макрос не выполняет вычисления, а только проверяет наличие букв в названиии, затем:смотрит проверку расширения; затем переходит сразу к End If и так по кругу . видимо:
Напрашивается очевидный вывод - расширение файла не .xls, т.к. проверка НЕ ПРОХОДИТ. Хотя...Тупанул. Переместите End If выше - перед Dir = avFiles
Код
Do While avFiles <> ""
'а тут добавляем проверку, что файл с нужным расширением
If Right(LCase(avFiles), 4) = ".xls" Then
If sActWB <> avFiles Then
Workbooks.Open sPath & avFiles, False
End If
bCnt = False
With Sheets(sShName1)
avArr = .UsedRange.Value
'Итоги по суммам
lc = Find_Col(avArr, sFndStr)
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row + 1
For li = 5 To 1 Step -1
If li = 1 And avArr(lr, lc - alStep(li - 1)) = 0 Then
bCnt = True
Else
adblSums(li) = adblSums(li) + avArr(lr, lc - alStep(li - 1))
End If
Next li
'Итоги по Кол-во мест:
lc = Find_Col(avArr, sFndCntStr) + 1
lr = .Cells(.Rows.Count, lc - 1).End(xlUp).Row
If bCnt Then
adblSums(1) = adblSums(1) + avArr(lr, lc) + avArr(lr, lc + 1)
Else
dblCntSum = dblCntSum + avArr(lr, lc) + avArr(lr, lc + 1)
End If
End With
If sActWB <> avFiles Then ActiveWorkbook.Close 0
End If'If Right(LCase(avFiles), 4) = ".xls"
avFiles = Dir
Loop
иначе мы просто бесконечно просматриваем один и тот же файл - первый.