MrExcel Color add-in

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Und falls Du noch mit 32 Bit VBA6 arbeitest, hier noch eine kleine Erweiterung...

Option Explicit

#If VBA7 Then

 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _

         ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

 Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal Hwnd As LongPtr, _

         ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, _

         ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

#Else

 Private Declare  Function FindWindow Lib "user32" Alias "FindWindowA" ( _

         ByVal lpClassName As String, ByVal lpWindowName As String) 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

#End If

Private Const HWND_TOPMOST = -1

Private Const HWND_NOTOPMOST = -2

Private Const cFLAGS = 3

Sub SetThisAllwaysOnTop()

   SetWindowPos FindWindow(vbNullString, "Legacy Colors"), HWND_TOPMOST, 0, 0, 0, 0, cFLAGS

End Sub

viele Grüße
Karl-Heinz

Hallo Michael,
teste mal:

Option Explicit

Private Declare Function ChooseColorA Lib "comdlg32.dll" ( _
    pChoosecolor As ChooseColor) As Long

Private Type ChooseColor
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Function ShowColor(Optional PresetColor As Long = 0) As Long
    Dim udtColor As ChooseColor
    Dim lngCustomColors(0 To 15) As Long
    udtColor.lStructSize = Len(udtColor)
    udtColor.lpCustColors = VarPtr(lngCustomColors(0))

    udtColor.flags = 0 'normal
    ' udtColor.flags = 2 'erweitert

    If ChooseColorA(udtColor) <> 0 Then
        ShowColor = udtColor.rgbResult
    Else
        ShowColor = -1
    End If
End Function

Public Sub Test()
    Dim lngColor As Long
    lngColor = ShowColor
    If lngColor >= 0 Then
        ActiveCell.Interior.Color = lngColor
    Else
        MsgBox "Abgebrochen"
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread