Ошибка частной подписки при запуске publi c sub - PullRequest
0 голосов
/ 10 июля 2020

У меня есть Public Sub, который работает сам по себе. У меня есть два Private Sub на двух разных листах. Каждый из них работает самостоятельно. Но я получаю ошибку на одном из Private Sub каждый раз, когда запускаю Public Sub. Но как только я остановлю код, я все смогу сделать как обычно. Почему при каждом запуске Public Sub возникает ошибка? Вот Private Sub, где я получаю сообщение об ошибке:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculate

Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngPH1, rngPH2, rngPH3, rngPH4, rngPH5, rngPH6, rngPH7, rngPH8 As Range

Set ws1 = Worksheets("Budget Hours")
Set ws2 = Worksheets("Schedule")

Set rngPH1 = ws2.Range("E7:E27")
Set rngPH2 = ws2.Range("E43:E63")
Set rngPH3 = ws2.Range("E79:E99")
Set rngPH4 = ws2.Range("E115:E135")
Set rngPH5 = ws2.Range("E151:E171")
Set rngPH6 = ws2.Range("E187:E207")
Set rngPH7 = ws2.Range("E222:E242")
Set rngPH8 = ws2.Range("E259:E279")

'Phase 01
If Not Intersect(Target, rngPH1) Is Nothing Then
    Dim rng1 As Range, rng2 As Range, msg1, a As Long

    Set rng1 = ws1.Range("E6:E10")
    Set rng2 = rng1.Offset(0, Target.Row - 6)

    msg1 = rng2.EntireColumn.Cells(3).Value & vbNewLine
    For a = 1 To rng1.Cells.Count
        If rng2.Cells(a).Value > 0 Then
            msg1 = msg1 & vbNewLine & rng1.Cells(a).Value & " - " & rng2.Cells(a).Value & " Hours"
        End If
    Next a

MsgBox msg1, , ws1.Range("E5").Value

'Phase 02
ElseIf Not Intersect(Target, rngPH2) Is Nothing Then
    Dim rng3 As Range, rng4 As Range, msg2, b As Long

    Set rng3 = ws1.Range("E15:E19")
    Set rng4 = rng3.Offset(0, Target.Row - 42)

    msg2 = rng4.EntireColumn.Cells(3).Value & vbNewLine
    For b = 1 To rng3.Cells.Count
        If rng4.Cells(b).Value > 0 Then
            msg2 = msg2 & vbNewLine & rng3.Cells(b).Value & " - " & rng4.Cells(b).Value & " Hours"
        End If
    Next b

MsgBox msg2, , ws1.Range("E14").Value

'Phase 03
ElseIf Not Intersect(Target, rngPH3) Is Nothing Then
    Dim rng5 As Range, rng6 As Range, msg3, c As Long

    Set rng5 = ws1.Range("E24:E28")
    Set rng6 = rng5.Offset(0, Target.Row - 78)

    msg3 = rng6.EntireColumn.Cells(3).Value & vbNewLine
    For c = 1 To rng5.Cells.Count
        If rng6.Cells(c).Value > 0 Then
            msg3 = msg3 & vbNewLine & rng5.Cells(c).Value & " - " & rng6.Cells(c).Value & " Hours"
        End If
    Next c

MsgBox msg3, , ws1.Range("E23").Value

'Phase 04
ElseIf Not Intersect(Target, rngPH4) Is Nothing Then
    Dim rng7 As Range, rng8 As Range, msg4, d As Long

    Set rng7 = ws1.Range("E33:E43")
    Set rng8 = rng7.Offset(0, Target.Row - 114)

    msg4 = rng8.EntireColumn.Cells(3).Value & vbNewLine
    For d = 1 To rng7.Cells.Count
        If rng8.Cells(d).Value > 0 Then
            msg4 = msg4 & vbNewLine & rng7.Cells(d).Value & " - " & rng8.Cells(d).Value & " Hours"
        End If
    Next d

MsgBox msg4, , ws1.Range("E32").Value

'Phase 05
ElseIf Not Intersect(Target, rngPH5) Is Nothing Then
    Dim rng9 As Range, rng10 As Range, msg5, e As Long

    Set rng9 = ws1.Range("E48:E52")
    Set rng10 = rng9.Offset(0, Target.Row - 150)

    msg5 = rng10.EntireColumn.Cells(3).Value & vbNewLine
    For e = 1 To rng9.Cells.Count
        If rng10.Cells(e).Value > 0 Then
            msg5 = msg5 & vbNewLine & rng9.Cells(e).Value & " - " & rng10.Cells(e).Value & " Hours"
        End If
    Next e

MsgBox msg5, , ws1.Range("E47").Value

'Phase 06
ElseIf Not Intersect(Target, rngPH6) Is Nothing Then
    Dim rng11 As Range, rng12 As Range, msg6, f As Long

    Set rng11 = ws1.Range("E57:E61")
    Set rng12 = rng11.Offset(0, Target.Row - 186)

    msg6 = rng12.EntireColumn.Cells(3).Value & vbNewLine
    For f = 1 To rng11.Cells.Count
        If rng12.Cells(f).Value > 0 Then
            msg6 = msg6 & vbNewLine & rng11.Cells(f).Value & " - " & rng12.Cells(f).Value & " Hours"
        End If
    Next f

MsgBox msg6, , ws1.Range("E56").Value

'Phase 07
ElseIf Not Intersect(Target, rngPH7) Is Nothing Then
    Dim rng13 As Range, rng14 As Range, msg7, g As Long

    Set rng13 = ws1.Range("E66:E70")
    Set rng14 = rng13.Offset(0, Target.Row - 221)

    msg7 = rng14.EntireColumn.Cells(3).Value & vbNewLine
    For g = 1 To rng13.Cells.Count
        If rng14.Cells(g).Value > 0 Then
            msg7 = msg7 & vbNewLine & rng13.Cells(g).Value & " - " & rng14.Cells(g).Value & " Hours"
        End If
    Next g

MsgBox msg7, , ws1.Range("E65").Value

'Phase 08
ElseIf Not Intersect(Target, rngPH8) Is Nothing Then
    Dim rng15 As Range, rng16 As Range, msg8, h As Long

    Set rng15 = ws1.Range("E75:E79")
    Set rng16 = rng15.Offset(0, Target.Row - 258)

    msg8 = rng16.EntireColumn.Cells(3).Value & vbNewLine
    For h = 1 To rng15.Cells.Count
        If rng16.Cells(h).Value > 0 Then
            msg8 = msg8 & vbNewLine & rng15.Cells(h).Value & " - " & rng16.Cells(h).Value & " Hours"
        End If
    Next h

MsgBox msg8, , ws1.Range("E74").Value

End If
End Sub

Рабочий лист Budget Hours - это то место, где находится Public Sub. Итак, я запускаю его с помощью кнопки, а затем получаю сообщение об ошибке «Приложение определено или определено объектом» в строке Set rng2 = rng1.Offset(0, Target.Row - 6)

Еще одна странная вещь. Мои последние несколько строк кода в Public Sub следующие:

    Application.ScreenUpdating = True

    Columns("B:AA").AutoFit

    Range("A10").Select

    Worksheets("Schedule").Range("E1:E311").SpecialCells(xlCellTypeVisible).RowHeight = 12

    Sheets("Schedule").Protect
End Sub

Он запускает Autofit и .Select даже при выдаче ошибки, но не запускает .RowHeight или .Protect.

Почему он выдает ошибку каждый раз, когда я запускаю Public Sub, даже если каждая часть сама по себе работает нормально?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...