Добрый день, мастера экселя и макроса
Подскажите пожалуйста.
Пытаюсь допилить свой макрос, и чтобы он более "нормальным", я понимаю что мне необходимо применить функцию "ЦИКЛ".
Сам макрос прикладываю.
Суть следующая => на вкладках с "1" по "16", одна и та же табличка с расчетом оценки своего поставщика, при выполнении макроса, он создает папку, сохраняет туда файлик в формате pdf и создает письмо
Вопрос => как циклом сделать макрос, чтобы он прошелся только по вкладкам с "1" по "16", и выполнил функцию "Select Case"
P.S.
Я читал статьи по циклу, но примеры больше для выполнения на одном листе какой-то функции...
Извиняюсь заранее, если не правильно оформил описание макроса
Подскажите пожалуйста.
Пытаюсь допилить свой макрос, и чтобы он более "нормальным", я понимаю что мне необходимо применить функцию "ЦИКЛ".
Сам макрос прикладываю.
Суть следующая => на вкладках с "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
|
Я читал статьи по циклу, но примеры больше для выполнения на одном листе какой-то функции...
Извиняюсь заранее, если не правильно оформил описание макроса
Изменено: - 11.11.2019 16:13:31
