Application.screenupdating设置为false doens不起作用

时间:2017-12-05 08:06:43

标签: vba excel-vba excel

所以,我是VBA的新手,我有这个代码,在两个表中添加一个新行,一个是sheet3上可见的表,另一个是sheet5上隐藏的表。我现在的问题是,ScreenUpdating在开头设置为false,结尾处为true,当代码运行时,屏幕仍然闪烁显示隐藏的工作表。如何让这个闪烁停止?

            Sub Add_Observation()
            '
            Application.ScreenUpdating = False
            Sheet3.Activate
            ActiveSheet.Unprotect
            Sheet5.Visible = True
                    Dim Ar As Integer, Br As Integer, A As Integer
                    '
                    Ar = Columns("B").Find(What:="S/N", After:=Range("B26")).Row 'Searching row of "S/N" header
                    Br = Range("B" & Ar).End(xlDown).Row 'Searching last row in EQUIPMENT table
                    A = (Br + 4)
                    B = (Br + 5)

                    Sheet5.Select
                    Dim Qr As Integer, Dr As Integer, D As Integer, D1 As Integer
                    '
                    Qr = Columns("B").Find(What:="S/N", After:=Range("B16")).Row
                    Dr = Range("B" & Qr).End(xlDown).Row
                    D = (Dr + 4)
                    D1 = (Dr + 2)


               Sheet3.Select
                Cells(Dr, "C").Select

            If Range(Cells(Ar, 1), Cells(A, 1)).EntireRow.Hidden = False Then

                                                                            Sheet3.Activate
                                                                                Rows(A).Insert Shift:=xlDown  'Inserting new row
                                                                                Cells(Br + 1, "B") = Cells(Br, "B") + 1 'Adding a sequential Number
                                                                                Rows(Br).Copy 'Copying format of last row
                                                                                Rows(Br + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row
                                                                                Application.CutCopyMode = False 'Deactivating copy mode

            Sheet5.Select
            If Range(Cells(Qr, 1), Cells(D, 1)).EntireRow.Hidden = False Then
                                                                            Sheet5.Activate
                                                                                Selection.Rows(D).Insert Shift:=xlDown  'Inserting new row
                                                                                Rows(D1).Insert Shift:=xlDown
                                                                                Cells(Dr + 1, "B") = Cells(Dr, "B") + 1 'Adding a sequential Number
                                                                                Rows(Dr).Copy 'Copying format of last row
                                                                                Rows(Dr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row
                                                                                Application.CutCopyMode = False 'Deactivating copy mode



            Application.ScreenUpdating = True
            Else: GoTo G
                End If
            End If

G:

            Sheet3.Activate
                Range(Cells(Ar, 1), Cells(A, 1)).Select
                  Selection.EntireRow.Hidden = False

            Sheet5.Activate
                Range(Cells(Qr, 1), Cells(D, 1)).Select
                Selection.EntireRow.Hidden = False

            Sheet3.Select


            Sheet5.Visible = False
            Cells(Br, "C").Select
            Sheet3.Activate
            ActiveSheet.Protect
            Application.ScreenUpdating = True
            End Sub

2 个答案:

答案 0 :(得分:0)

我只是做第一点来给你一个想法:

  Sub Add_Observation()
        '
        Application.ScreenUpdating = False
        with Sheet3
            .Unprotect
        End With
        With Sheet5
                Dim Ar As Integer, Br As Integer, A As Integer
                '
                Ar =. Columns("B").Find(What:="S/N", After:=.Range("B26")).Row 'Searching row of "S/N" header
                Br = .Range("B" & Ar).End(xlDown).Row 'Searching last row in EQUIPMENT table
                A = (Br + 4)
                B = (Br + 5)


                Dim Qr As Integer, Dr As Integer, D As Integer, D1 As Integer
                '
                Qr = .Columns("B").Find(What:="S/N", After:=.Range("B16")).Row
                Dr = .Range("B" & Qr).End(xlDown).Row
                D = (Dr + 4)
                D1 = (Dr + 2)

     end With
      With  Sheet3
            'Cells(Dr, "C").Select

        If .Range(.Cells(Ar, 1), .Cells(A, 1)).EntireRow.Hidden = False Then

 with sheet5
     .Rows(Dr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row

      Application.CutCopyMode = False 'Deactivating copy mode

 .Rows(D).Insert Shift:=xlDown  'Inserting new row

   .Rows(D1).Insert Shift:=xlDown

  .Cells(Dr + 1, "B") = 'Cells(Dr, "B") + 1 'Adding a sequential Number

  .Rows(Dr).Copy 'Copying format of last row

答案 1 :(得分:0)

这是一种kludge,但是通过将例程包装在另一个子程序中,尝试在日常工作之外打开和关闭屏幕更新。

从代码中删除所有application.screenupdating行,否则它们将覆盖下面的代码。

Public Sub callAdd_Observation()
    Application.ScreenUpdating = False
    Call Add_Observation
    Application.ScreenUpdating = True
End Sub