Mac ScrollBar上的Vba只允许双击

时间:2014-07-18 14:12:07

标签: excel macos vba scroll

我在Mac Excel上发现了非常奇怪的情况。出于某些奇怪的原因,滚动条会在双击时作出反应,但不会单击并按下鼠标按钮。 为了测试它,我创建了空白表单并将该代码添加到表单初始化: UserForm1.ScrollBars=MsForms.fmScrollBarsBoth UserForm1.ScrollWidth=900 UserForm1.ScrollHeight=900

然后运行它,发现滚动条只会双击并移动。

谁可以帮助我?

2 个答案:

答案 0 :(得分:0)

我的mac 2011版本内置滚动条有同样的问题。我不得不通过创建我自己的带有图片的滚动条来为它提供背景,按钮的文本框(我必须使文本框非常窄以摆脱光标闪烁问题) - 鼠标控件仅适用于几个控件和唯一一个为此目的工作的是文本框)然后我必须在图片范围内使用10个标签,以编程方式定位它们并使它们看不见但仍然存在..我必须这样做允许用户使用标签上的click事件跳转到滚动条中的各个位置。然后我不得不在图片的顶部和底部添加箭头按钮,使其外观和感觉像滚动条。我花了一天的时间来弄清楚所有的代码。我让它记录了表单上每个项目的所有当前位置数据,这样它就能记住每个对象的默认位置,然后当滚动条从其默认位置移动时,所有其他对象在相反方向上均匀移动。所有这一切都是一种巨大的痛苦..它运作良好,但实际上,微软应该能够对其表单控件进行编程以正确地执行它们的功能而且我们不应该做所有这些,否则就可以解决编程中的微软错误祝你好运..

答案 1 :(得分:0)

这可能会有所帮助...... 这是我的mac 2011垂直滚动条解决方法的代码:

Public ScrollPosition, MaxScroll As Long
Public TrueBottomScroll As Double
Public ButtonScroll, ScrollUpDown As Boolean
Dim xOffset As Single
Dim yOffset As Single
Public RelativeTop As Double
Public ButtonResize As Boolean
Dim cmdArray() As New Class1

'Scroll Left to Right (ctrlMoveMe):

Public BtnMoveMe As Boolean
Public ScrollLeftRight As Boolean
Dim MoveMe_xOffset As Single
Public MoveMe_MaxScroll As Long

Function ScrollPos(y As Long)

Dim cCont As Control
Dim ScrollRate, r, h As Long
Dim CtrlName As String

 If ScrollUpDown = True Then ButtonScroll = True

 ScrollBottom = ScrollBar1.Top + ScrollBar1.Height
MaxScroll = ScrollBottom - ScrollButton.Height

   If ButtonScroll = True Then
        If ScrollButton.Top + y < 28 Then
            ScrollButton.Top = 28
        ElseIf ScrollButton.Top + y > MaxScroll Then
            ScrollButton.Top = MaxScroll - 4
        Else
            ScrollButton.Top = (ScrollButton.Top + y)
        End If
    End If

TrueBottomScroll = Application.Max(Range("B:B"))
r = Application.Match(TrueBottomScroll, Range("B:B"), 0)
CtrlName = Range("A" & r)
h = Me.Controls(CtrlName).Height
TrueBottomScroll = TrueBottomScroll + h
'MsgBox TrueBottomScroll

ScrollRate = TrueBottomScroll / MaxScroll

ScrollPosition = (ScrollButton.Top - 28) * ScrollRate


Dim OriginalPos As Long
    For Each cCont In Me.Controls
        If cCont.name = "ScrollButton" _
            Or cCont.name = "ScrollBar1" _
            Or cCont.name = "cmdScrollUp" _
            Or cCont.name = "cmdScrollDown" _
            Or cCont.name = "ctrResizeWindow" _
            Or cCont.name = "ScrollBarJump1" _
            Or cCont.name = "ScrollBarJump2" _
            Or cCont.name = "ScrollBarJump3" _
            Or cCont.name = "ScrollBarJump4" _
            Or cCont.name = "ScrollBarJump5" _
            Or cCont.name = "ScrollBarJump6" _
            Or cCont.name = "ScrollBarJump7" _
            Or cCont.name = "ScrollBarJump8" _
            Or cCont.name = "ScrollBarJump9" _
            Or cCont.name = "ScrollBarJump10" Then
        Else
            OriginalPos = Application.Index(Range("A:B"), Application.Match(cCont.name, Range("A:A"), 0), 2)
            cCont.Top = OriginalPos - ScrollPosition
        End If
    Next cCont
    If ScrollUpDown = True Then
    ScrollUpDown = False
    ButtonScroll = False
    End If
End Function



Private Sub cmdScrollUp_Click()
ScrollUpDown = True
    ScrollPos (-35)
End Sub
Private Sub cmdScrollDown_Click()
ScrollUpDown = True
    ScrollPos (35)
End Sub


Private Sub ctrl_MoveMe_Click()
BtnMoveMe = True
ScrollLeftRight = True
MoveMe_ScrollPos (x)
End Sub

Private Sub ctrl_MoveMe_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
BtnMoveMe = True
End Sub

Private Sub ctrlMoveMe_Enter()
BtnMoveMe = True
End Sub
Private Sub ctrlMoveMe_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If BtnMoveMe = True Then Me.ctrlMoveMe.Left = Me.ctrlMoveMe.Left + x

' If BtnMoveMe = True Then MoveMe_ScrollPos (x)
End Sub
Private Sub ctrlMoveMe_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
BtnMoveMe = False
End Sub





Private Sub ScrollBarJump1_Click()
Me.ScrollButton.Top = Me.ScrollBar1.Top + 5
End Sub

Private Sub ScrollBarJump2_Click()
n = 2
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub

Private Sub ScrollBarJump3_Click()
n = 3
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub

Private Sub ScrollBarJump4_Click()
n = 4
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump5_Click()
n = 5
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump6_Click()
n = 6
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump7_Click()
n = 7
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump8_Click()
n = 8
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump9_Click()
n = 9
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub
Private Sub ScrollBarJump10_Click()
n = 10
Me.ScrollButton.Top = Me.ScrollBar1.Top + ((Me.ScrollBar1.Height / 10) * n) - (Me.ScrollButton.Height * (0.1 * n))
End Sub

Private Sub ScrollButton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       ButtonScroll = True
End Sub

Private Sub ScrollButton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
 ScrollPos (y)
End Sub

Private Sub ScrollButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    ButtonScroll = False
End Sub

Private Sub UserForm_Initialize()
DisableEvents
Me.Width = 500

Dim ScrollBottom, r, NewWidth, n, NewLeft As Long
NewWidth = 15
NewLeft = Me.Width - NewWidth - 5

'''''''''''''''''''''''''
'Scroll Jump:
For n = 1 To 10
    With Me.Controls("ScrollBarJump" & n)
        .Height = ScrollBar1.Height / 10
        .Top = 30 + (.Height * (n - 1))
        .Left = NewLeft + 3
        .Width = NewWidth - 7.5
        .Caption = ""
    End With
Next
''''''''''''''''''''''

 With ctrResizeWindow
        .Width = 10
        .Left = Me.Width - .Width
        .Height = 10
        .Top = Me.Height - 22 - .Height
    End With

    ''''''' End ResizeWindow --> Begin Vertical ScrollBar''''''''



    With ScrollButton
        .Height = 40
        .Top = 30
        .Left = NewLeft + 3
        .Width = NewWidth - 7.5
        .ZOrder msoBringToFront
    End With

    With ScrollBar1
        .Height = Me.Height - 74
        .Top = .Top
        .Left = NewLeft
        .Width = NewWidth
    End With

    With cmdScrollUp
    .Height = .Height
        .Top = .Top
        .Left = NewLeft
        .Width = NewWidth
    End With

    With cmdScrollDown
    .Height = .Height
        .Top = ScrollBar1.Top + ScrollBar1.Height
        .Left = NewLeft
        .Width = NewWidth
    End With


ScrollBottom = ScrollBar1.Top + ScrollBar1.Height
MaxScroll = ScrollBottom - ScrollButton.Height
ScrollPosition = ScrollButton.Top - 28


On Error GoTo SheetExists
Sheets.Add.name = "ScrollBarData"
EditSheet:
On Error GoTo 0
Sheets("ScrollBarData").Activate

r = 1
    For Each cCont In Me.Controls
        If cCont.name = "ScrollButton" _
            Or cCont.name = "ScrollBar1" _
            Or cCont.name = "cmdScrollUp" _
            Or cCont.name = "cmdScrollDown" _
            Or cCont.name = "ctrResizeWindow" _
            Or cCont.name = "ScrollBarJump1" _
            Or cCont.name = "ScrollBarJump2" _
            Or cCont.name = "ScrollBarJump3" _
            Or cCont.name = "ScrollBarJump4" _
            Or cCont.name = "ScrollBarJump5" _
            Or cCont.name = "ScrollBarJump6" _
            Or cCont.name = "ScrollBarJump7" _
            Or cCont.name = "ScrollBarJump8" _
            Or cCont.name = "ScrollBarJump9" _
            Or cCont.name = "ScrollBarJump10" Then
        Else
            Cells(r, 1) = cCont.name
            Cells(r, 2) = cCont.Top
            r = r + 1
        End If

    Next cCont

    Exit Sub

SheetExists:
Application.DisplayAlerts = False
    'MsgBox ActiveSheet.name
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    GoTo EditSheet
End Sub



Private Sub UserForm_Terminate()
EnableEvents
Application.DisplayAlerts = False
   Sheets("ScrollBarData").Delete
   Application.DisplayAlerts = True
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''



Private Sub ctrResizeWindow_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        If x > 0 Then xOffset = Me.Width - (ctrResizeWindow.Left + x)
        If y > 0 Then yOffset = Me.Height - (ctrResizeWindow.Top + y)

        ScrollBottom = ScrollBar1.Top + ScrollBar1.Height
       MaxScroll = ScrollBottom - ScrollButton.Height
       If RelativeTop = 0 Then
            RelativeTop = ScrollButton.Top / MaxScroll
       End If
   ButtonResize = True
End Sub

Private Sub ctrResizeWindow_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
   Dim FormHeight, ResizeMin As Integer
  ResizeMin = 30


   If ButtonResize = True Then
    If (ctrResizeWindow.Left + x) + xOffset < ResizeMin + 100 Then GoTo WindowIsNarrow
        Me.Width = (ctrResizeWindow.Left + x) + xOffset
WindowIsNarrow:
        ctrResizeWindow.Left = Me.Width - ctrResizeWindow.Width
                If (ctrResizeWindow.Top + y) + yOffset < ResizeMin + 100 Then GoTo WindowIsSmall
        Me.Height = (ctrResizeWindow.Top + y) + yOffset
        ctrResizeWindow.Top = Me.Height - 22 - ctrResizeWindow.Height
WindowIsSmall:
        Dim ScrollBottom, r, NewLeft, NewWidth As Long


NewWidth = 15
NewLeft = Me.Width - NewWidth - 5

 FormHeight = Me.Height - 74
  If FormHeight < ResizeMin Then Exit Sub



    With ScrollBar1
        .Height = Me.Height - 74
        .Top = .Top
        .Left = NewLeft
        .Width = NewWidth
    End With

    With cmdScrollUp
    .Height = .Height
        .Top = .Top
        .Left = NewLeft
        .Width = NewWidth
    End With

    With cmdScrollDown
    .Height = .Height
        .Top = ScrollBar1.Top + ScrollBar1.Height
        .Left = NewLeft
        .Width = NewWidth
    End With

    ScrollBottom = ScrollBar1.Top + ScrollBar1.Height
    MaxScroll = ScrollBottom - ScrollButton.Height
   ' End If
        With ScrollButton
        .Height = 40
        .Top = MaxScroll * RelativeTop
        .Left = NewLeft + 3
        .Width = NewWidth - 7.5
    End With


    '''''''''''''''''''''''''
'Scroll Jump:
For n = 1 To 10
    With Me.Controls("ScrollBarJump" & n)
        .Height = ScrollBar1.Height / 10
        .Top = 30 + (.Height * (n - 1))
        .Left = NewLeft + 3
        .Width = NewWidth - 7.5
        .Caption = ""
    End With
Next
''''''''''''''''''''''


    End If
End Sub

Private Sub ctrResizeWindow_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  xOffset = 0
    yOffset = 0
    ButtonResize = False

End Sub

'-----------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------
Rem  ~~> All Items above this line are for the userform controls.... & _
                  Items Below are for this userforms controls:



Private Sub cmdCloseForm_Click()
        Unload Me
End Sub