Excel完美工具箱(更新到9.7.1版,兼容07,10,13,16)多功能插件

佛山小老鼠

你发一个完整的代码，我测试一下看，现在主要是不能复制区域，谢谢

win2009

佛山小老鼠 发表于 2012-8-26 23:56
你发一个完整的代码，我测试一下看，现在主要是不能复制区域，谢谢

Option Explicit



Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
    x As Long
    Y As Long
End Type

Dim m_blnTimerOn As Boolean
Dim m_lngTimerId As Long
Dim m_NewRange As Range
Dim m_OldRange As Range
Sub StartTimer()
    If Not m_blnTimerOn Then
        m_lngTimerId = SetTimer(0, 0, 0.05, AddressOf TimerProc)
        m_blnTimerOn = True
        ' Set m_OldRange = ActiveSheet.Range("A1")
    End If
End Sub
Public Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lngCurPos As POINTAPI
    '
    On Error Resume Next
    GetCursorPos lngCurPos
    Set m_NewRange = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.Y)
    With m_NewRange
        If m_OldRange.Address <> .Address Then
            Dim R As Long, C As Long
            R = .Row
            C = .Column
            Rows(R).Select
'            Union(Columns(C), Rows(R)).Select
        End If
    End With
    Set m_OldRange = m_NewRange
    TimerProc = 0
End Function

Sub StopTimer()
    If m_blnTimerOn Then
        KillTimer 0, m_lngTimerId
        m_blnTimerOn = False
    End If
End Sub
Public Sub 开始()
    ActiveSheet.ScrollArea = Selection.Address
    StartTimer
End Sub
Public Sub 结束()
    ActiveSheet.ScrollArea = ""
    StopTimer
End Sub

佛山小老鼠

win2009 发表于 2012-8-27 00:02
Option Explicit

我试了一下，还是不能复制。

win2009

佛山小老鼠 发表于 2012-8-27 00:06
我试了一下，还是不能复制。

我实在解决，屏幕不乱动的问题，锁定后不能复制，接触后就能了
这个功能非常关键，否则这个就没法用，你看看大家的一件都在这里
就是屏幕乱动

佛山小老鼠

win2009 发表于 2012-8-27 00:10
我实在解决，屏幕不乱动的问题，锁定后不能复制，接触后就能了
这个功能非常关键，否则这个就没法用，你 ...

谢谢你辛苦了,到时代码完美时我再添加进来

佛山小老鼠

Excel完美工具箱2012年8月27日中午13:100分更新到9.0.4版
更新的内容：修正了批量删除和插入空行的一些Bub

zy0211

多谢分享了，下载个看看，本人是新手，对EXCEL还不熟悉

zpsxj

很实用的箱子啊。呵呵
收藏了。

lisamm

强烈要求高人---佛山小老鼠把Excel完美工具箱9.0.4版本里的播放器源代码公布给大家学习观摩研究！！！！！

lisamm

有没有Excel数据自动导入Access的功能?????????????我好象没有找到.