【求助】如何使按键始终显示在我看得到的地方

Dreamer_09

不知道可不可以描述清楚，这样一个问题：

我设置了一个按键类型的控件，但是我的工作表很长，当我滚动工作表到下面的时候

那个按键也被滚到看不到的地方了……（滚到上面去了）

有什么办法能让按键一直显示在屏幕上，而不因为我拖动工作表而被拖上去？

不知道这样描述清楚了么？

老申

变通一下：

把按键放在第1、2行，再冻结窗格（定格前2行）

Dreamer_09

QUOTE:

以下是引用老申在2007-11-15 14:49:58的发言：

变通一下：

把按键放在第1、2行，再冻结窗格（定格前2行）

OK～真是太感谢了～

但是还是想多问一句，如果我就是想实现“让按键始终浮在指定位置”这样的功能，要怎么做呢？属性里可以设置么？或者有什么代码么？

zlt518

在工具栏添加宏自定义按钮

[此贴子已经被作者于2007-11-15 15:03:40编辑过]

Dreamer_09

QUOTE:

以下是引用zlt518在2007-11-15 14:59:53的发言：

在工具栏添加宏自定义按钮

没有听明白……能说的稍微详细一点么？

wangminbai

QUOTE:

以下是引用Dreamer_09在2007-11-15 14:55:52的发言：

OK～真是太感谢了～

但是还是想多问一句，如果我就是想实现“让按键始终浮在指定位置”这样的功能，要怎么做呢？属性里可以设置么？或者有什么代码么？

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 ChangeOn As Boolean
Dim m_lngTimerId As Long
'
Sub StartTimer()
    If Not ChangeOn Then
        m_lngTimerId = SetTimer(0, 0, 200, AddressOf TimerProc)
        ChangeOn = True
    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
    On Error Resume Next
    If Sheets(1).CommandButton1.Top <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60 Then Sheets(1).CommandButton1.Top = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60
    If Sheets(1).CommandButton1.Left <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100 Then Sheets(1).CommandButton1.Left = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100
    TimerProc = 0
End Function
Sub StopTimer()
    On Error Resume Next
    If ChangeOn = True Then
        KillTimer 0, m_lngTimerId
        ChangeOn = False
    End If
End Sub

见附件

 

oCxelnbZ.rar (11.95 KB, 下载次数: 1072)

2007-11-15 15:13 上传

点击文件名下载附件
【求助】如何使按键始终显示在我看得到的地方

zlt518

在工具栏--自定义--命令--自定义按钮

点住自定义按钮，拖至工具栏的适当位置，放开即可；

然后，右键点击连接宏。

Dreamer_09

QUOTE:

以下是引用wangminbai在2007-11-15 15:13:58的发言：

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 ChangeOn As Boolean
Dim m_lngTimerId As Long
'
Sub StartTimer()
    If Not ChangeOn Then
        m_lngTimerId = SetTimer(0, 0, 200, AddressOf TimerProc)
        ChangeOn = True
    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
    On Error Resume Next
    If Sheets(1).CommandButton1.Top <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60 Then Sheets(1).CommandButton1.Top = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60
    If Sheets(1).CommandButton1.Left <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100 Then Sheets(1).CommandButton1.Left = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100
    TimerProc = 0
End Function
Sub StopTimer()
    On Error Resume Next
    If ChangeOn = True Then
        KillTimer 0, m_lngTimerId
        ChangeOn = False
    End If
End Sub

见附件

万分感谢，我拿去研究已下了～

老申

QUOTE:

以下是引用wangminbai在2007-11-15 15:13:58的发言：

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 ChangeOn As Boolean
Dim m_lngTimerId As Long
'
Sub StartTimer()
    If Not ChangeOn Then
        m_lngTimerId = SetTimer(0, 0, 200, AddressOf TimerProc)
        ChangeOn = True
    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
    On Error Resume Next
    If Sheets(1).CommandButton1.Top <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60 Then Sheets(1).CommandButton1.Top = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top + 60
    If Sheets(1).CommandButton1.Left <> Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100 Then Sheets(1).CommandButton1.Left = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left + 100
    TimerProc = 0
End Function
Sub StopTimer()
    On Error Resume Next
    If ChangeOn = True Then
        KillTimer 0, m_lngTimerId
        ChangeOn = False
    End If
End Sub

见附件

 

学习了！！

Dreamer_09

看来VBA实现这个确实不是很理想

但是6楼的前辈写的实在是太强了

学到了很多东西

受教了，万分感谢