VBA ExcelのListBoxコントロールでTabStopsを設定

Question

初めて投稿したhere Randy Birchがクリップボード形式をリストアップしました。ご覧のように、彼は "List1" ListBoxに対応するウィンドウを処理するWNDPROCにLB_SETTABSTOPSメッセージを送信した後、List1に対してVisual Basic 6と.Refreshメソッドを使用しています

.RefreshメソッドはVBA（と.Hwndでも、それはthis post by C. PEARSONとPrivate Declare Function GetFocus Lib "user32"() As Longの問題はあまりありません）、私はそれを模倣しようとしました。

Apparentlyの場合、.RefreshメソッドはListBoxウィンドウのクライアント領域全体を無効にし、WM_PAINTメッセージをメッセージキューの他のペンディングメッセージをバイパスしてWNDPROCに送信し、更新領域の即時再描画を引き起こします。この特定のケースでは可視の "List1" ListBox全体

マイ設定：中

Debug.Print Application.Version 
Debug.Print Application.VBE.Version 
Debug.Print Application.OperatingSystem 

#If VBA6 Then 
    Debug.Print "VBA6 = True" 
#Else 
    Debug.Print "VBA6 = False" 
#End If 

#If VBA7 Then 
    Debug.Print "VBA7 = True" 
#Else 
    Debug.Print "VBA7 = False" 
#End If 

結果：

16.0 
7.01 
Windows (32-bit) NT 10.00 
VBA6 = True 
VBA7 = True 

今、私の試み＃1：

Option Explicit 

Private Const LB_SETTABSTOPS As Long = &H192 
Private Const EM_SETTABSTOPS As Long = &HCB 

Private Const RDW_ALLCHILDREN = &H80 
Private Const RDW_ERASE = &H4 
Private Const RDW_ERASENOW = &H200 
Private Const RDW_FRAME = &H400 
Private Const RDW_INTERNALPAINT = &H2 
Private Const RDW_INVALIDATE = &H1 
Private Const RDW_NOCHILDREN = &H40 
Private Const RDW_NOERASE = &H20 
Private Const RDW_NOFRAME = &H800 
Private Const RDW_NOINTERNALPAINT = &H10 
Private Const RDW_UPDATENOW = &H100 
Private Const RDW_VALIDATE = &H8 

Private hWndList1 As Long 

Private Type Rect 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 
Private Declare Function GetFocus Lib "user32"() As Long 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr 
Private Declare PtrSafe Function UpdateWindow Lib "user32" (ByVal hWnd As LongPtr) As Boolean 
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef lpRect As Rect) As Long 
Private Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, ByRef lprcUpdate As Rect, ByVal hrgnUpdate As Long, Optional ByVal flags As Integer) As Boolean 
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As Rect, ByVal bErase As Boolean) As Long 
Private Declare Function GetUpdateRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As Rect, ByVal bErase As Boolean) As Boolean 
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As Rect) As Boolean 
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (ByRef lpRect As Rect) As Long 
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As Rect) As Long 
Private Declare Function GetDesktopWindow Lib "user32"() As Long 

Private Sub UserForm_Initialize() 

Dim ListWindowUpdated As Boolean 
Dim ListWindowRedrawn As Boolean 

ReDim TabStop(0 To 1) As Long 

TabStop(0) = 90 
TabStop(1) = 130 

With List1 

    .Clear 

    .SetFocus 
    hWndList1 = GetFocus 

    Call SendMessage(hWndList1, LB_SETTABSTOPS, 0&, ByVal 0&) 
    Call SendMessage(hWndList1, LB_SETTABSTOPS, 2, TabStop(0)) 

    Dim rectList1 As Rect 
    Call GetWindowRect(hWndList1, rectList1) 
    Dim lprcList1 As Long 
    lprcList1 = VarPtrArray(rectList1) 

    ListWindowRedrawn = RedrawWindow(hWndList1, rectList1, lprcList1, RDW_INVALIDATE) 
    ListWindowRedrawn = RedrawWindow(hWndList1, rectList1, 0, RDW_INVALIDATE) 

    MsgBox "ListWindowRedrawn = " & ListWindowRedrawn & " and RDW_INVALIDATE message sent" 
    'Call RedrawWindowAny(hWndForm2, vbNull, 1&, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ALLCHILDREN) 

    ListWindowUpdated = UpdateWindow(hWndList1) 
    MsgBox "ListWindowUpdated = " & ListWindowUpdated 

End With 

End Sub 

私の試み＃2：

Dim ScreenRect As Rect 
    Dim hClientRect As Long 
    hClientRect = GetClientRect(hWndList1), ScreenRect) 

    Dim udtScrDim As Rect 
    Dim lReturn As Long 
    Dim hRegion As Long 

    udtScrDim.Left = 0 
    udtScrDim.Top = 0 
    udtScrDim.Right = ScreenRect.Right - ScreenRect.Left 
    MsgBox "Screen width = " & ScreenRect.Right - ScreenRect.Left 
    udtScrDim.Bottom = ScreenRect.Bottom - ScreenRect.Top 
    MsgBox "Screen height = " & ScreenRect.Bottom - ScreenRect.Top 
    hRegion = CreateRectRgnIndirect(udtScrDim) 

    If hRegion <> 0 Then 
     lReturn = RedrawWindow(0, udtScrDim, hRegion, RDW_ERASE Or RDW_FRAME Or RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_INTERNALPAINT Or RDW_ALLCHILDREN) 
    End If 

多くのアテンプの後で、私は依然としてカスタムタブストップ位置で更新されるクライアント領域を取得できません。しかし、上記の試み＃1はまだ私にとってより論理的であるようです。正常に動作し、エラーは発生しませんが、何も変更されず、ListBox内のすべてのアイテム（vbTabを含む）は、後でUserForm1.Repaintを指定しても影響を受けません。

助けてください:)

が

Answer 1

これはかなりの答えが、より多くの回避策はありません：（ランディバーチとの）問題の私の理解では、

：

のみ、について説明があることであるVBAリストボックスコントロールは単にLB_SETTABSTOPSメッセージを処理できません。実際には、後でLB_SETTABSTOPSメッセージを送信しようとしましたが、それでも無視されます。無効化メッセージとWM_PAINTの場合と同じことです。

これは、Office開発者がVBA Excelで.ColumnWidthプロパティを実装したもので、これは前述の操作とまったく同じことができます。