Excel Application.InputBox位置

Question

使用此函数的顶部和左侧参数时，是否有中心屏幕选项，或者它始终是数字吗？

我使用它而不是常规输入框，因为它可以更好地处理cancel事件，但它始终显示在屏幕的右下角，对您的帮助不大：/

Answer 1

没有中央屏幕选项。 您必须进行计算。 但是，假设您使用的是Excel 2007或更高版本，则还有另一个问题...

这对我来说是个新闻，但是在谷歌搜索和测试中，我发现在Excel 2007和2010 Application.Inputbox中，无论“顶部”和“左侧”设置如何，Inputbox都会恢复到最后一个位置。 即使从新的工作表中调用一个新的输入框，此问题似乎仍然存在。 当我在XL 2​​003中尝试时，它可以正常工作，并且Inputbox放置在正确的左右坐标处。

您可以将输入框拖到所需位置，然后保存。 除非稍后有人拖动它，否则它将在同一位置重新打开。

这是指向某人的解决方案的链接，该解决方案可以使人恢复正确的行为，并解决输入框居中的问题。 它确实需要API调用，因此请在尝试之前保存您的工作。

编辑-根据JMax的评论，这是上面链接中的代码。 它是由vbforums.com网站上名为KoolSid的用户执行的：

Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" (ByVal idHook As Long, _
ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

'~~> Handle to the Hook procedure
Private hHook As Long

'~~> Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5

'~~> SetWindowPos Flags
Private Const SWP_NOSIZE = &H1      '<~~ Retains the current size
Private Const SWP_NOZORDER = &H4    '<~~ Retains the current Z order

Dim InputboxTop As Long, InputboxLeft As Long

Sub TestInputBox()
    Dim stringToFind As String, MiddleRow As Long, MiddleCol As Long

    hHook = SetWindowsHookEx(WH_CBT, _
    AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)

    '~~> Get the center cell (keeping the excel menus in mind)
    MiddleRow = ActiveWindow.VisibleRange.Rows.Count / 1.2
    '~~> Get the center column
    MiddleCol = ActiveWindow.VisibleRange.Columns.Count / 2

    InputboxTop = Cells(MiddleRow, MiddleCol).Top
    InputboxLeft = Cells(MiddleRow, MiddleCol).Left

    '~~> Show the InputBox. I have just used "Sample" Change that...
    stringToFind = Application.InputBox("Sample", _
    "Sample", "Sample", InputboxLeft, InputboxTop, , , 2)
End Sub

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

    If lMsg = HCBT_ACTIVATE Then
        '~~> Change position
        SetWindowPos wParam, 0, InputboxLeft, InputboxTop, _
        0, 0, SWP_NOSIZE + SWP_NOZORDER

        '~~> Release the Hook
        UnhookWindowsHookEx hHook
    End If

    MsgBoxHookProc = False
End Function

Answer 2

您可以测试常规输入框以查看是否按下了取消键，并且它具有始终居中的额外好处。 只需使用StrPtr（variable）= 0对其进行测试。 简单！

避免用户单击“ OK”而不键入任何内容的另一种方法是在输入框内添加一个默认值开始，即您知道如果它返回一个空字符串，则很可能是由于按下了“取消”按钮。

如果选择了取消，StrPtr将返回0（对于vbNullString，btw也返回0）。 请注意，StrPtr可在VB5，VB6和VBA中使用，但由于尚未得到官方的支持，因此可能会在几年后变得无用。 我非常怀疑他们会摆脱它，但是如果您打算分发该应用程序，则值得考虑。

Sub CancelTest()

Dim temp As String

temp = InputBox("Enter your name", "Cancel Test")
If StrPtr(temp) = 0 Then
    ' You pressed cancel
Else
    If temp = "" Then
        'You pressed OK but entered nothing
    Else
        'Do your thing
    End If
End If

End Sub

有关strptr的更多信息： StrPtr（S）返回指向当前存储在S中的实际字符串数据的指针。这是将字符串传递给Unicode API调用时所需的。 您获得的指针指向数据字符串字段，而不是长度前缀字段。 在COM术语中，StrPtr返回BSTR指针的值。 （来自出色的网站： http : //www.aivosto.com/vbtips/stringopt2.html ）

Answer 3

' assume normal screen  else go through GetDeviceCaps(hDCDesk, LOGPIXELSX) etc etc
' 1440 twips / inch  pts / pix = 3/4  inch 100 pts
'  so twips / pixel = 15

Sub GetRaXy(Ra As Range, X&, Y&)    ' in twips
    Dim ppz!
    ppz = ActiveWindow.Zoom / 75  '  zoom is %   so   100 * 3/4  =>75
' only  the pixels of rows and columns are zoomed 
  X = (ActiveWindow.PointsToScreenPixelsX(0) + Ra.Left * ppz) * 15
  Y = (ActiveWindow.PointsToScreenPixelsY(0) + Ra.Top * ppz) * 15
End Sub

Function InputRealVal!(Optional RaTAdd$ = "K11")
Dim IStr$, RAt As Range, X&, Y&
Set RAt = Range(RaTAdd)
    GetRaXy RAt, X, Y
    IStr = InputBox(" Value ", "ENTER The Value ", 25, X, Y)
    If StrPtr(IStr) = 0 Then
        MsgBox "Cancel Pressed"
        Exit Function
    End If
    If IsNumeric(IStr) Then
        InputRealVal = CDec(IStr)
    Else
        MsgBox "Bad data entry"
        Exit Function
    End If
End Function