Всем привет. Подскажите пожалуйста как поправить код что бы скрытые строки несколькими фильтрами пропускались при обработке макросом [vba]
Код
Sub createFiles() Application.ScreenUpdating = False Dim folderName$, myPath$ Dim avFiles myPath = ThisWorkbook.Path Set sh = ThisWorkbook.Sheets(1) avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "1", , True) ' Set template = Workbooks.Open(avFiles(1)) template.Sheets(5).Protect "1", UserInterfaceOnly:=True template.Sheets(2).Protect "1", UserInterfaceOnly:=True With sh For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row folderPath = myPath & "\" & .Cells(i, 17) & " " & .Cells(i, 15) If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath) With template.Sheets(5) .[o53] = sh.Cells(i, 14) End With With template.Sheets(2) .[A4] = sh.Cells(i, 1): .[d7] = sh.Cells(i, 4): .[s7] = sh.Cells(i, 5) .[H9] = sh.Cells(i, 7): .[x9] = sh.Cells(i, 8): .[AH9] = sh.Cells(i, 6) .[d11] = sh.Cells(i, 2): .[I11] = sh.Cells(i, 3): .[AH11] = sh.Cells(i, 9) .[d13] = sh.Cells(i, 10): .[j13] = sh.Cells(i, 11): .[N13] = sh.Cells(i, 12): .[AC13] = sh.Cells(i, 13) .[d15] = sh.Cells(i, 15): .[S15] = sh.Cells(i, 16) template.SaveCopyAs folderPath & "\" & sh.Cells(i, 7) & " " & sh.Cells(i, 4) & " " & sh.Cells(i, 18) & ".xlsm" End With Next i End With template.Close False Application.ScreenUpdating = True MsgBox "ÃÎÒÎÂÎ!" End Sub
[/vba]
ну и до кучи не могу описать условие отмены Application.GetOpenFilename пишу наподобие такого [vba]
Код
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "1", , True) if avFiles = cancel Then Exit Sub Else: Set template = Workbooks.Open(avFiles(1)) end if
[/vba] Отмена начинает срабатывать а выбор файла нет Выручайте.
Всем привет. Подскажите пожалуйста как поправить код что бы скрытые строки несколькими фильтрами пропускались при обработке макросом [vba]
Код
Sub createFiles() Application.ScreenUpdating = False Dim folderName$, myPath$ Dim avFiles myPath = ThisWorkbook.Path Set sh = ThisWorkbook.Sheets(1) avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "1", , True) ' Set template = Workbooks.Open(avFiles(1)) template.Sheets(5).Protect "1", UserInterfaceOnly:=True template.Sheets(2).Protect "1", UserInterfaceOnly:=True With sh For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row folderPath = myPath & "\" & .Cells(i, 17) & " " & .Cells(i, 15) If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath) With template.Sheets(5) .[o53] = sh.Cells(i, 14) End With With template.Sheets(2) .[A4] = sh.Cells(i, 1): .[d7] = sh.Cells(i, 4): .[s7] = sh.Cells(i, 5) .[H9] = sh.Cells(i, 7): .[x9] = sh.Cells(i, 8): .[AH9] = sh.Cells(i, 6) .[d11] = sh.Cells(i, 2): .[I11] = sh.Cells(i, 3): .[AH11] = sh.Cells(i, 9) .[d13] = sh.Cells(i, 10): .[j13] = sh.Cells(i, 11): .[N13] = sh.Cells(i, 12): .[AC13] = sh.Cells(i, 13) .[d15] = sh.Cells(i, 15): .[S15] = sh.Cells(i, 16) template.SaveCopyAs folderPath & "\" & sh.Cells(i, 7) & " " & sh.Cells(i, 4) & " " & sh.Cells(i, 18) & ".xlsm" End With Next i End With template.Close False Application.ScreenUpdating = True MsgBox "ÃÎÒÎÂÎ!" End Sub
[/vba]
ну и до кучи не могу описать условие отмены Application.GetOpenFilename пишу наподобие такого [vba]
Код
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "1", , True) if avFiles = cancel Then Exit Sub Else: Set template = Workbooks.Open(avFiles(1)) end if
[/vba] Отмена начинает срабатывать а выбор файла нет Выручайте. Sancho
Сообщение отредактировал Sancho - Понедельник, 06.06.2016, 17:45
По второму вопросу что-то типа этого должно быть (последние 2 строки) [vba]
Код
fileToOpen = Application.GetOpenFilename("All Files (*.*),*.*") If fileToOpen = False Then Exit Sub Workbooks.Open (fileToOpen) Set w2 = ActiveWorkbook
[/vba]
По второму вопросу что-то типа этого должно быть (последние 2 строки) [vba]
Код
fileToOpen = Application.GetOpenFilename("All Files (*.*),*.*") If fileToOpen = False Then Exit Sub Workbooks.Open (fileToOpen) Set w2 = ActiveWorkbook
SLAVICK, ой как здорово! боялся, что цикл все равно будет по всем строкам пробегать, а тут прям все быстро получается , СПАСИБО ВАМ!!!
сам ваял вот это [vba]
Код
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If Rows(i).Hidden = True Then
End If
[/vba] но ни как не соображу что надо ставить после then. понимаю что надо вернуться в начало цикла а вот как, не знаю. то что интуитивно ставил next i после then не прокатывало(
SLAVICK, ой как здорово! боялся, что цикл все равно будет по всем строкам пробегать, а тут прям все быстро получается , СПАСИБО ВАМ!!!
сам ваял вот это [vba]
Код
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If Rows(i).Hidden = True Then
End If
[/vba] но ни как не соображу что надо ставить после then. понимаю что надо вернуться в начало цикла а вот как, не знаю. то что интуитивно ставил next i после then не прокатывало(Sancho
Сообщение отредактировал Sancho - Понедельник, 06.06.2016, 22:34