如何将VBA代码（子代码）重用于其他几个子代码中

时间：2018-10-18 07:56:32

标签： excel vba excel-vba

我目前使用vba更新了50 wb的即时消息。但这是一次拖动（和更新）相同代码50次的工作，因此我试图提出一种重新使用代码的方法。所有wb的结构都相同（工作表名称等），因此基本的“ update-vba”应可在所有“ UpdateGroup-subs”中重用。我的想法是将定义和基本的“ update-vba”放在“ UpdateGroup-subs”之外的子目录中，并在运行每个“ UpdateGroup-sub”时调用它们。但是我遇到了编译错误（变量未定义）。我要做什么甚至有可能吗？任何可以帮助我解决这个问题的人吗？我正在上传2个版本，一个正在运行（重复每个“ UpdateGroup-sub”中的所有代码），另一个是我试图简化此版本的尝试...

作品：

Option Explicit
'************************************************************************

Sub UpdateAllGroups_1_WorksOK()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup1
    Call UpdateGroup2

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub UpdateGroup1()

'DEFINITIONS
Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\Group1_(M).xlsm")    'must be changed in each UpdateGroup-sub
    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

ThisGroupWb = "Group1_(M).xlsm"     'must be changed in each UpdateGroup-sub
ReportR2ob = "R2ob - Group1.xls"    'must be changed in each UpdateGroup-sub
ReportR1vo = "R1vo - Group1.xls"    'must be changed in each UpdateGroup-sub
ReportR2vo = "R2vo - Group1.xls"    'must be changed in each UpdateGroup-sub


'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

Private Sub UpdateGroup2()

'DEFINITIONS
Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\Group2_(M).xlsm")    'must be changed in each UpdateGroup-sub
    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

ThisGroupWb = "Group2_(M).xlsm"     'must be changed in each UpdateGroup-sub
ReportR2ob = "R2ob - Group2.xls"    'must be changed in each UpdateGroup-sub
ReportR1vo = "R1vo - Group2.xls"    'must be changed in each UpdateGroup-sub
ReportR2vo = "R2vo - Group2.xls"    'must be changed in each UpdateGroup-sub


'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

不工作：

Option Explicit
'************************************************************************

Sub UpdateAllGroups_2_DoesntWork()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup1
    Call UpdateGroup2

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub Definitions()

Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

End Sub
'************************************************************************

Private Sub UpdateGroups()

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\ThisGroupWb")

'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

Private Sub UpdateGroup1()

Call Definitions
    ThisGroupWb = "Group1_(M).xlsm"
    ReportR2ob = "R2ob - Group1.xls"
    ReportR1vo = "R1vo - Group1.xls"
    ReportR2vo = "R2vo - Group1.xls"
Call UpdateGroups

End Sub
'************************************************************************

Private Sub UpdateGroup2()

Call Definitions
    ThisGroupWb = "Group2_(M).xlsm"
    ReportR2ob = "R2ob - Group2.xls"
    ReportR1vo = "R1vo - Group2.xls"
    ReportR2vo = "R2vo - Group2.xls"
Call UpdateGroups

End Sub

1 个答案:

答案 0 :(得分：1)

您应该在子例程中使用参数，如下所示：

<li *ngIf="Authentication.roleMatch(['Fetch user',
          'add user',
          'edit user',
          'change status',
          'delete user',
          'delete role',
          'Fetch Recuirtmentdetails'])">
          <a  routerLink="/role"class="dropdown-item">User Role</a>
</li>

或者，更接近于您所做的事情：

def get_headers():
    headers = {
        #'Content-Type': "application/json",
        'Authorization': access_token_json
    }
    return headers

def get_nexttokensync_list_event():
    url_get_list_event = "https://www.googleapis.com/calendar/v3/calendars/id@gmail.com/events"
    querystring = {"nextSyncToken": "CMCEh************jd4CGAU="}
    response = requests.request("GET", url_get_list_event, headers=headers, params=querystring)
    json_event_list_formatted = response.text
    print(json_event_list_formatted)
相关问题
最新问题