Renk Seçme Diyaloğu

' UserForm ve bir adet CommandButton1 ekleyin.
#If VBA7 And Win64 Then
    Private Type CHOOSECOLOR_TYPE
        lStructSize    As LongLong
        hwndOwner      As LongLong
        hInstance      As LongLong
        rgbResult      As LongLong
        lpCustColors   As String
        flags          As LongLong
        lCustData      As LongLong
        lpfnHook       As LongLong
        lpTemplateName As String
    End Type
#Else
    Private Type CHOOSECOLOR_TYPE
        lStructSize    As Long
        hwndOwner      As Long
        hInstance      As Long
        rgbResult      As Long
        lpCustColors   As String
        flags          As Long
        lCustData      As Long
        lpfnHook       As Long
        lpTemplateName As String
    End Type
#End If

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR_TYPE) As LongLong
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
#Else
    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR_TYPE) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Function ShowColor() As Long
    Dim cc As CHOOSECOLOR_TYPE
    Dim Custcolors(0 To 63) As Byte

    ' Renk diyaloğu ekranın sol üst köşesi yerine form üzerinde çıkması için hWnd
    cc.hwndOwner = FindWindow(vbNullString, Me.Caption)
#If VBA7 And Win64 Then
    cc.lStructSize = CLngLng(Len(cc))
#Else
    cc.lStructSize = Len(cc)
#End If
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.flags = 0

    ShowColor = IIf(ChooseColor(cc) <> 0, cc.rgbResult, -1)
End Function

Private Sub CommandButton1_Click()
    Dim NewColor As Long
    
    NewColor = ShowColor
    
    If NewColor <> -1 Then
        Me.BackColor = NewColor
    End If
End Sub

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

“Renk Seçme Diyaloğu” için 2 yorum

  1. Merhaba. Ben bunu kullanmayı beceremedim. Kusuruma bakmazsanız bir örnek dosya koymanızı rica edebilirmiyim. İyi günler dilerim.

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


2 + 5 =