Excel Application.InputBox位置

Question

使用此功能的頂部和左側參數是否有一箇中心屏幕選項，或它將始終是一個數字？

我用它來代替常規的輸入框，因爲它處理取消事件更好，但它總是出現在屏幕的右下角小於有所幫助：/

Answer 1

您可以測試常規的輸入框，看是否取消被按下，它始終爲中心的額外中獲益，只需使用StrPtr（變量）= 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 2

沒有屏幕中心的選項。你必須計算它。但是，假設您使用Excel 2007或更高版本，還有另一個問題...

這是我的新聞，但在使用Google和Google測試中，我發現Excel 2007和2010中的Application.Inputbox恢復到最後的位置，無視頂部和左側設置。即使從新工作表調用新的Inputbox，該問題似乎仍然存在。當我在XL 2​​003中試用它時，它可以正常工作，並且Inputbox被放置在正確的左右座標處。

你也許只需將Inputbox拖動到你想要的位置然後保存。除非有人拖後，否則會在同一地方重新開放。

這裏有一個link to a solution，有人爲了恢復正確的行爲，也解決了輸入框居中。它確實需要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 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