Страницы: 1
RSS
Выполнить повторяющееся действие макроса в заданных листах книги
 
Добрый день, мастера экселя и макроса

Подскажите пожалуйста.
Пытаюсь допилить свой макрос, и чтобы он более "нормальным", я понимаю что мне необходимо применить функцию "ЦИКЛ".
Сам макрос прикладываю.
Суть следующая => на вкладках с "1" по "16", одна и та же табличка с расчетом оценки своего поставщика, при выполнении макроса, он создает папку, сохраняет туда файлик в формате pdf и создает письмо
Вопрос => как циклом сделать макрос, чтобы он прошелся только по вкладкам с "1" по "16", и выполнил функцию "Select Case"
Код
Sub Скругленныйпрямоугольник1_Щелчок()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String

'Отключение отоброжения выполняемых действий
Application.ScreenUpdating = False


'Create folder => act of defective parts
MkDir "G:\"

'Save in sheet in pdf format
ThisWorkbook.Sheets(Array("1")).Select
  

Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("2")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("3")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

ThisWorkbook.Sheets(Array("4")).Select
  
Select Case Range("V7").Value

Case Is < 0.75: Call Scoreless
Case Is >= 0.75: Call Scoremore

End Select

'Open folder
Sheets("1").Select
Shell "explorer.exe " & "G:" & "\", vbMaximizedFocus


End Sub
----------------------------------------------------------
Sub Scoremore()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:" & _
ActiveSheet.Range("D4").Value & Range("X3") & "2019.pdf", _
OpenAfterPublish:=False

Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)
With objMail
.To = Range("E51").Value
.CC = Range("E52").Value
.Body =
.Display
End With
Set objMail = Nothing
Set objOL = Nothing

End Sub
-----------------------------------------------------------
Sub Scoreless()

'return for normal print area
ActiveSheet.PageSetup.PrintArea = "$B$2:$AA$48"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:" & _
ActiveSheet.Range("D4").Value & " - " & Range("X3") & " 2019.pdf", _
OpenAfterPublish:=False

'Save detail information about score card for supplier
ActiveSheet.PageSetup.PrintArea = "$AE$2:$AX$58"
'ActiveSheet.VPageBreaks.DragOff Direction:=xlToRight, RegionIndex:=1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="G:\" & _
ActiveSheet.Range("D4").Value & Range("X3") & "2019 - detail information.pdf", _
OpenAfterPublish:=False

'return for normal print area
ActiveSheet.PageSetup.PrintArea = "$B$2:$AA$48"


Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(0)
With objMail
.To = Range("E51").Value
.CC = Range("E52").Value
.Body = 
.Subject = 
.Display
End With
Set objMail = Nothing
Set objOL = Nothing

End Sub

P.S.
Я читал статьи по циклу, но примеры больше для выполнения на одном листе какой-то функции...
Извиняюсь заранее, если не правильно оформил описание макроса :)  
Изменено: alextlt - 11.11.2019 16:13:31
 
Код
dim wsN&
for wsN = 1 to 16
  with Worksheets(wsN)
    Select Case .Range("V7").Value 
      Case Is < 0.75: Call Scoreless
      Case Is >= 0.75: Call Scoremore 
    End Select
  end with
next
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Название темы сейчас общее, должно отражать задачу,. Предложите. Модератор заменят.
 
название темы:
как выполнить повторяющееся действие макроса в заданных листах книги
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
alextlt, теперь Ваша благодарность Игорю должна быть умножена на два )
 
Ого, так быстро, ответили!
Спасибо Вам ОГРОМНОЕ! :)
Сейчас опробую))))
 
и если листы действительно называются "1", "2", "3" ...
то тогда:
Код
with Worksheets("" & wsN)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
В общем работает, НО))))
У меня 16 вкладок/листов, и теперь он создает 16 писем с одинаковой темой....

Как я понял он при выполнении цикла, постоянно ссылается на 1 вкладку...
 
Код
dim wsN&
for wsN = 1 to 16
  Worksheets(wsN).activate
  Select Case Range("V7").Value 
    Case Is < 0.75: Call Scoreless
    Case Is >= 0.75: Call Scoremore 
  End Select
next
Изменено: Ігор Гончаренко - 11.11.2019 16:48:03
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Подскажите пожалуйста, что означает - dim wsN& ?
ws - Worksheets
N& - содержится только число?
Изменено: alextlt - 11.11.2019 16:59:59
 
wsN - имя переменной, может быть КАКИМ УГОДНО, главное чтобы не противоречило правилам определения имен
wsN& - & в этой конструкции определяет тип переменной (длинное целое) традиционное обьявление должно было выглядеть так:
dim wsN as long
но
dim wsN&
полностью эквивалентно
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Я единственное не понял, как тогда он определяет, что надо пройтись по листам, а не ячейкам, или чему-нибудь еще...?
Код
for wsN = 1 to 16
 
мне тоже все труднее понимать Ваши вопросы
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
alextlt написал:
Я единственное не понял, как тогда он определяет, что надо пройтись по листам, а не ячейкам, или чему-нибудь еще...?Код ? 1for wsN = 1 to 16
Там два цикла,  первый: for WorksheetsN =1 to 16 next worksheesN
и внутри него Select Case Range("V7").Value
макрос сначала выбирает лист потом меняет ячейки, потом выбирает следующий лист снова меняет и так до 16го листа
 
Доброе утро, Всем)))
Большое Вам СПАСИБО Ігор Гончаренко, Вы мне очень помогли! ;)
И Вам спасибо KLIJIN за пояснение!
Страницы: 1
Наверх