Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
как пропустить файл с расширением .xlsm, если в коде указано, что работаем с расширением: avFiles = Dir(sPath & "*.xls")??
 
Здравтсвуйте! Прошу помощи, в вопросе того, что макрос обращается к файлу с расширением .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 <> ""... как можно уточнить расширение?
Снимок.PNG (7.37 КБ)
Изменено: Советник I категории - 14 Фев 2020 11:26:50
 
Есть такая беда с Dir - берет только первую часть расширения. Поэтому единственный вариант это дополнительно сравнивать расширение файла уже внутри цикла.

P.S. какой-то уж очень знакомый код...
Изменено: Дмитрий(The_Prist) Щербаков - 14 Фев 2020 11:37:30
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
походу решение выглядит таким образом, старый вариант:
Код
Do While avFiles <> ""  
я поменял на вот такой:
Код
Do While LCase(avFiles) Like "*.xls"
после чего больше не выдает ошибки на присутствие в папке файлов со сторонним расширением.
привет The Pirsty! , - твой макрос живёт и развивается)
Изменено: Советник I категории - 14 Фев 2020 11:42:09
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
P.S. какой-то уж очень знакомый код..
Вы прям помните??? это было в 13 году,- как можно помнить!!?? столько времени прошло, не реально же......
-я через два дня как в первый раз смотрю на код.....
Изменено: Советник I категории - 14 Фев 2020 11:45:44
 
Цитата
Советник I категории написал:
Do While LCase(avFiles) Like "*.xls"
думаю, это не совсем правильно. По факту - до первого файла с нужным расширением.
Правильнее будет после этой строки
Код
Do While avFiles <> ""
добавить условие
Код
If right(lcase(avFiles),4) = ".xls" then
'обработка файла
end if
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
If right(lcase(avFiles),4)
цифра 4 что означает? Не подскажете?
 
Четыре правых символа )
 
класс!
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Цитата
Советник I категории  написал:Do While LCase(avFiles) Like "*.xls"думаю, это не совсем правильно. По факту - до первого файла с нужным расширением.
по факту всё суммирует: 6 инвойсов в папке подсчитано(суммы вашего макроса, - верхние), а ненужный пропущен:
Снимок.PNG (12.07 КБ)
Изменено: Советник I категории - 14 Фев 2020 13:16:24
 
Цитата
Советник I категории написал:
всё суммирует
Предположу, что первыми просматриваются сейчас файлы 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
 
Цитата
Советник I категории написал:
Do While Right(LCase(avFiles), 4) = ".xls" ' зе пирст дал
я НЕ ЭТО дал. Вы бы хоть переписывали правильно. Я написал это:
Цитата
Дмитрий(The_Prist) Щербаков написал:
после этой строки
Do While avFiles <> ""

добавить условие

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
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Т.е. цикл так и должен был остаться:
я так и делал раньше, как в коде, который вы сейчас выложили: макрос виснет, после нажатия на Esc кажет вот это:
Снимок.PNG (6.87 КБ)
 
макрос не выполняет вычисления, а только проверяет наличие букв в названиии,
затем:смотрит проверку расширения;
затем переходит сразу к End If и так по кругу . видимо:
 
Снимок.PNG (3.71 КБ)
Снимок.PNG (5.26 КБ)
Снимок.PNG (3.59 КБ)
Снимок.PNG (4.16 КБ)
Изменено: Советник I категории - 14 Фев 2020 14:05:58
 
Напрашивается очевидный вывод - расширение файла не .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
иначе мы просто бесконечно просматриваем один и тот же файл - первый.
Изменено: Дмитрий(The_Prist) Щербаков - 14 Фев 2020 14:07:36
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
расширение файла не .xls,
таки, вроде .xls ясно написано... что не так????
Снимок.PNG (25.8 КБ)
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Переместите End If выше - перед Dir = avFiles
я всегда верил в вас! спасибо!!!ура.

кайф полный в этой жижни хоть сегодня.
Снимок.PNG (12.83 КБ)
Изменено: Советник I категории - 14 Фев 2020 14:13:30
 
Здравствуйте!

Можно еще попробовать
Код
avFiles = Dir(sPath + "*.xls") 
 
zav, Вы бы с первого сообщения тему прочитали. Из этой строки проблема и пошла:
Цитата
Советник I категории написал:
avFiles = Dir(sPath & "*.xls")  -вот тут задал расширение
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Советник I категории написал:...в этой жижни
от слова "жижа"? Незавидная жизнь :)
Страницы: 1
Читают тему (гостей: 1)
Наверх