vba Excel Application.InputBox 位置
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8466002/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Application.InputBox Position
提问by NickSlash
With the Top and Left arguments for this function is there a Centre screen option, or will it always be a number?
对于这个函数的 Top 和 Left 参数是否有一个中心屏幕选项，或者它总是一个数字？
I'm using this instead of a regular inputbox as it handles the cancel event better but it always appears in the bottom right of the screen which is less than helpful :/
我正在使用它而不是常规输入框，因为它可以更好地处理取消事件，但它总是出现在屏幕的右下角，这不太有用：/
回答by Doug Glancy
There is no center screen option. You'd have to calculate it. But, assuming you are using Excel 2007 or later, there's another issue...
没有中央屏幕选项。你得计算一下。但是，假设您使用的是 Excel 2007 或更高版本，还有另一个问题...
This was news to me, but in googling and testing I see that in Excel 2007 and 2010 Application.Inputbox reverts to its last position, disregarding the Top and Left settings. This problem seems to persist even if a new Inputbox is called from a new worksheet. When I try it in XL 2003 it works correctly, and the Inputbox is placed at the correct left and right coordinates.
这对我来说是新闻，但在谷歌搜索和测试中，我看到在 Excel 2007 和 2010 Application.Inputbox 恢复到它的最后一个位置，忽略顶部和左侧设置。即使从新工作表调用新输入框，此问题似乎仍然存在。当我在 XL 2003 中尝试它时它工作正常，并且输入框被放置在正确的左右坐标处。
You can maybe just drag the Inputbox where you want and then save. Unless somebody drags it later, it will re-open in the same place.
您可以将输入框拖到您想要的位置然后保存。除非后来有人拖了它，否则它会在同一个地方重新打开。
Here's a link to a solutionthat worked for somebody to bring back the correct behavior, and also addresses centering the inputbox. It does require API calls, so save your work before you try it.
这是一个解决方案的链接，该解决方案可以帮助某人恢复正确的行为，并且还解决了将输入框居中的问题。它确实需要 API 调用，因此请在尝试之前保存您的工作。
EDIT - Per JMax's comment, here's the code from the link above. It's by a user called KoolSid on the vbforums.com site:
编辑 - 根据 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
回答by aevanko
You can test the regular inputbox to see if cancel was pressed, and it has the extra benifit of always being centered. Just use StrPtr(variable) = 0to test it. Simple!
您可以测试常规输入框以查看是否按下了取消，并且它具有始终居中的额外好处。只需使用StrPtr(variable) = 0来测试它。简单的！
Another way to avoid a user hitting OK with nothing typed is to add a default value inside the input box to start with, that way you know that if it returns an empty string, it's most likely due to the cancel button being pressed.
另一种避免用户在没有输入任何内容的情况下点击 OK 的方法是在输入框中添加一个默认值作为开始，这样您就知道如果它返回一个空字符串，很可能是由于按下了取消按钮。
StrPtr will return a 0 if cancel was selected (also returns 0 for vbNullString, btw). Please note that StrPtr work in VB5, VB6, and VBA, but since it's not officially supported, it could be rendered unusuable years down the line. I highly doubt they'd get rid of it but it's worth considering if this is an application you plan to distribute.
如果选择取消，StrPtr 将返回 0（对于 vbNullString 也返回 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
Some more info on strptr:StrPtr(S) returns a pointer to the actual string data currently stored in S. This is what you need when passing the string to Unicode API calls. The pointer you get points to the Datastring field, not the Length prefix field. In COM terminology, StrPtr returns the value of the BSTR pointer. (from the fantastic site: http://www.aivosto.com/vbtips/stringopt2.html)
关于 strptr 的更多信息：StrPtr(S) 返回一个指向当前存储在 S 中的实际字符串数据的指针。这是将字符串传递给 Unicode API 调用时需要的。您获得的指针指向 Datastring 字段，而不是 Length 前缀字段。在 COM 术语中，StrPtr 返回 BSTR 指针的值。（来自奇妙的网站：http: //www.aivosto.com/vbtips/stringopt2.html）
回答by Harry S
' 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
