日期:2014-05-20  浏览次数:20738 次

公司监管严,但难不住咋,VBA几句代码,绝对隐蔽看小说,在StatusBar 里面看小说
在EXECL里建一个test页,将小说拷到A这一列,建一个宏。
下面是代码,将小说显示在StatusBar 里面,并且将test页隐藏。。呵呵。谁能发现呢 。。


Dim i As Integer

Sub Macro1()
Sheets("test").Visible = False
Application.StatusBar = ThisWorkbook.Worksheets().Range("A" & Ctr(i + 1))
i = i + 1
Application.OnTime Now + TimeValue("00:00:03"), "Macro1"
End Sub


------解决方案--------------------
有这闲工夫你干吗不做点有用的事儿呢...
------解决方案--------------------
哈哈
------解决方案--------------------
骑猪的小强:
你好调皮哟!
------解决方案--------------------
这怎么能说没用?起码对于我来说 我觉得很有意思 哈哈
------解决方案--------------------
呵呵,这个有点意思
与领导斗,其乐无穷啊

------解决方案--------------------
有意思,太有才了。
------解决方案--------------------
比较有才
------解决方案--------------------
你太有才了~~顶
------解决方案--------------------
比较适合养老...
------解决方案--------------------
你强 不过真要被发现了 估计死的比看小说被发现还难看。
------解决方案--------------------
看会小说也管,真晕哈哈
------解决方案--------------------
哈哈,你强!
------解决方案--------------------
学习了!~
------解决方案--------------------
有创意!
------解决方案--------------------
就是,实话
------解决方案--------------------
这个 很厉害
不管用不用
收藏先
------解决方案--------------------
牛人一大堆
------解决方案--------------------
拿分走人.
------解决方案--------------------
我只能说你是个创造者,你肯定是个有思想的程序员。
学有所有!高!高!高!高!高!高!高!高!
------解决方案--------------------
我是直接把页面的html拉到vs2005看的
------解决方案--------------------
虽然不看小说,还是mark一下
------解决方案--------------------
基本不看小说,眼睛痛~~~
------解决方案--------------------
VB code

'这是改进版
'------------------
'1. 看完后翻回文章开头
'2. 如果一行文字太长状态栏显示不下,就截断成两行
'------------------
Dim i As Integer

Sub Macro1()
    Sheets("test").Visible = False
    Dim MaxLineLen As Integer
    MaxLineLen = 30
    
    Dim cellNo As String
    cellNo = "A" & CStr(i + 1)
    Dim cellNextNo As String
    cellNextNo = "A" & CStr(i + 2)
    
    Dim str As String
    str = Sheets("test").Range(cellNo)
    
    If Len(str) > MaxLineLen Then
        'covent long line to 2 lines
        Dim leftStr As String
        Dim rightStr As String
        leftStr = Left(str, MaxLineLen)
        rightStr = Right(str, Len(str) - MaxLineLen)
        str = leftStr
        Sheets("test").Range(cellNo).Insert Shift:=xlDown
        Sheets("test").Range(cellNo) = leftStr
        Sheets("test").Range(cellNextNo) = rightStr
    End If
    Application.StatusBar = str
    i = i + 1
    If i > Sheets("test").[a65536].End(xlUp).Row Then
        i = 0
    End If
    Application.OnTime Now + TimeValue("00:00:03"), "Macro1"
End Sub