複数のマクロを1つにスタックする方法は？

Question

私は以下のマクロを見つけ、範囲をコピーして電子メールを作成するためにそれを使用しました。同じコードを複数のシートにコピーしました。どのように私は1つに、すべてのこれらのマクロを積み重ねることができます。

Sub Macro_Qu() 
' 
' Macro_Qu Macro 

' Don't forget to copy the function RangetoHTML in the module. 
' Working in Office 2000-2010 
    Dim rng As Range 
    Dim OutApp As Object 
    Dim OutMail As Object 

    With Application 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Set rng = Nothing 
    On Error Resume Next 
    Set rng = Sheets("Qusai").Range("A2:J20").SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    If rng Is Nothing Then 
     MsgBox "The selection is not a range or the sheet is protected" & _ 
       vbNewLine & "please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    On Error Resume Next 
    With OutMail 
     .To = "Qu@msn.com" 
     .CC = "" 
     .BCC = "" 
     .Subject = "Test" 
     .HTMLBody = RangetoHTML(rng) 
     .Display 'or use .Send 
    End With 
    On Error GoTo 0 

    With Application 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 

    Set OutMail = Nothing 
    Set OutApp = Nothing 

End Sub 

Answer 1

だけパラメータとして変化する値を渡す：

Sub Test 
    Macro_Qu Sheets("Qusai").Range("A2:J20"), "Qu@msn.com", "Test" 
End Sub 

Sub Macro_Qu(parmRng As Range, parmTo As String, parmSubject As String) 
    Dim rng As Range 
    Dim OutApp As Object 
    Dim OutMail As Object 

    With Application 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Set rng = Nothing 
    On Error Resume Next 
    Set rng = parmRng.SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    If rng Is Nothing Then 
     MsgBox "The selection is not a range or the sheet is protected" & _ 
       vbNewLine & "please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    On Error Resume Next 
    With OutMail 
     .To = parmTo 
     .CC = "" 
     .BCC = "" 
     .Subject = parmSubject 
     .HTMLBody = RangetoHTML(rng) 
     .Display 'or use .Send 
    End With 
    On Error GoTo 0 

    With Application 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 

    Set OutMail = Nothing 
    Set OutApp = Nothing  
End Sub 

Answer 2

あなたが別のマクロ内から他のマクロを呼び出すためにこれを使用することができます：

call <macro name> 

しかし、この複合体を取得し始めている場合は、VBAを学ぶ時間がかかるかもしれません:)