整个Excel窗口中的Flash颜色

时间:2016-12-23 10:52:57

标签: excel vba excel-vba

根据描述工作簿状态的某些条件,我尝试创建一个宏来在用户打开工作簿时刷新视觉提示。

我想要做的是用一种不影响单元格格式或任何内容的颜色填充整个屏幕/单元格区域/ excel边框主题(它只是暂时的)。 我目前的做法是制作一个形状来填充屏幕并适当地改变其填充颜色。

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'allows for pauses in the millisecond range

Sub Flash_routine()
    Dim FillCol As Long
    FillCol = RGB(255, 186, 49)

        ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 2000, 1000).Select
    For x = 1 To 2 'phase ie. lightingup, empty
        If x = 1 Then
            IncVal = 0.5
        Else
            IncVal = 0.05
        End If

        For i = 0 To 1 Step IncVal
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = FillCol
                If x = 1 Then
                    .Transparency = 1 - i
                Else
                    .Transparency = i
                End If
                .Solid
            End With
            Sleep 50
            'dictates time between successive shape fills
            ActiveWindow.SmallScroll down:=3
            ActiveWindow.SmallScroll up:=3
            'refreshes screen view

        Next i
    Next x

        Selection.Delete
End Sub

宏由workbook_open事件

调用

然而,有一些问题值得我帮助;

  • 首先,这是正确的做法还是有一些我不了解的屏幕色调应用程序?

  • 假设是 - 我的形状没有填满屏幕。我的印象是AddShape(msoShapeRectangle, 0, 0, 2000, 1000)将我的形状放在左上角(0,0),但它实际上放置了一点点(第1列,从我的窗口当前正在看的地方向下3行,例如。我正在查看F13:X55它的顶角放在F16中,对象覆盖其余的单元格而不是前三行

  • 如何参考形状?我不知道如何把它留给Selection.ShapeRange.Fill,但我知道选择的是糟糕的VBA练习
  • 最后,滚动更新窗口视图的最佳方法是什么?由于某种原因,偶尔它甚至不起作用,整个宏在没有看到任何东西的情况下运行

我知道有很多小问题,如果需要采用完全不同的方法,它们可能甚至不相关!此外,如果将excel主题从绿色更改为新颜色并逐渐再次返回是可能的,那将是非常时髦的。感谢您为新生儿VBAer提供解决方案或任何一般提示!

1 个答案:

答案 0 :(得分:2)

我相信你正在寻找像这样的形状控制:

更新:现在使用您的代码和Sleep功能...这对我有用,非常棒!

Sub Flash_routine()
Dim FillCol As Long
FillCol = RGB(255, 186, 49)

Dim w As Worksheet
Set w = ActiveSheet
Dim s As Shape

Set s = w.Shapes.AddShape(1, 1, 1, 2000, 2000)
For x = 1 To 2 'phase ie. lightingup, empty
    If x = 1 Then
        IncVal = 0.5
    Else
        IncVal = 0.05
    End If

    For i = 0 To 1 Step IncVal
        With s.Fill
            .Visible = msoTrue
            .ForeColor.RGB = FillCol
            If x = 1 Then
                .Transparency = 1 - i
            Else
                .Transparency = i
            End If
            .Solid
        End With
        Sleep 50
        'dictates time between successive shape fills
        DoEvents
        DoEvents
        'refreshes screen view

    Next i
Next x

    s.Delete
End Sub

显然只是概述了它是如何工作的,首先我定义s As Shape然后在Set s中创建形状,以便稍后可以引用s来修改它。

尝试一下,随时回来。在满足计时器/条件后,您可以使用s.Delete删除形状。

使用2个DoEvents(出于某种原因,它只为我使用了2个)强制屏幕更新显示您的更改而不滚动。

我使用Application.Wait,因为我对它更熟悉。

FYI - 矩形是形状1,因此您可以省去完全输入它的麻烦。我将形状1点水平和垂直放置在纸张的第一个点上。我不确定你是否可以做全屏色调,但如果需要的话,你可能会影响形状的不透明度