Optionbutton ile kodların çalıştırılması

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; Bir excel sayfamda Userform ekledim. Burada Option butonlar yaptım bunların altında özel sıralama seçenekleri için kodlar var, ancak bunları Option buton seçilerek PERSONEL sayfasında verilerin düzenlenmesini istiyorum, dosyam http://s5.dosya.tc/server/4k3zlg/SIRALAMA.xls.html burada

 

[Ömer BARAN]

Merhaba.

CommandButton1 kodlarını aşağıdaki şekilde değiştirerek dener misiniz?
.

[FONT="Arial Narrow"][B][COLOR="Blue"]Private Sub CommandButton1_Click()[/COLOR][/B]
'PERSONEL SAYFASINDAKİ VERİLER,
'OptionButton1 Seçildiğinde aşağıdaki kod çalışsın.
'OptionButton seçilmediğinde;  MsgBox "LÜTFEN Sıralama Seçimini Yapınız!..", vbCritical uyarısı versin

Dim SonKol  As Integer, _
        SonSat  As Long, _
        i       As Long, _
        Rutbe   As Variant, _
        sira    As Variant
    
    Rutbe = Array("1. Sınıf Emniyet Müdürü", _
                  "2. Sınıf Emniyet Müdürü", _
                  "3. Sınıf Emniyet Müdürü", _
                  "4. Sınıf Emniyet Müdürü", _
                  "Emniyet Amiri", _
                  "Başkomiser", _
                  "Komiser", _
                  "Komiser Yrd.", _
                  "Başpolis Memuru", _
                  "Polis Memuru", _
                  "Bekçi", _
                  "Teknisyen", _
                  "Teknisyen Yrd.")
                
    Application.ScreenUpdating = False
If OptionButton1 = True Then
    SonKol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    SonSat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    For i = 2 To SonSat
        sira = Application.Match(Cells(i, "E"), Application.Transpose(Rutbe), 0)
        Cells(i, SonKol) = sira
    Next i
    
    Range(Cells(2, 2), Cells(SonSat, SonKol)).Sort Key1:=Cells(1, SonKol), Key2:=Range("B1")
    Columns(SonKol).Delete 'Shift:=xlToLeft
        
    Application.ScreenUpdating = True
    
    MsgBox "LİSTE; RÜTBE SİCİLE GÖRE SIRALANMIŞTIR...", vbInformation, "TEŞEKKÜRLER"


'OptionButton2 Seçildiğinde aşağıdaki kod çalışsın.
ElseIf OptionButton2 = True Then
    SonKol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    SonSat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    For i = 2 To SonSat
        sira = Application.Match(Cells(i, "E"), Application.Transpose(Rutbe), 0)
        Cells(i, SonKol) = sira
    Next i
    
    Range(Cells(2, 2), Cells(SonSat, SonKol)).Sort Key1:=Cells(1, SonKol), Key2:=Range("C1"), Key2:=Range("D1")
    Columns(SonKol).Delete 'Shift:=xlToLeft
        
    Application.ScreenUpdating = True
    
    MsgBox "LİSTE; RÜTBE VE ADA GÖRE SIRALANMIŞTIR...", vbInformation, "TEŞEKKÜRLER"


'OptionButton3 Seçildiğinde aşağıdaki kod çalışsın.
ElseIf OptionButton3 = True Then
    Application.ScreenUpdating = False
    
    SonKol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    SonSat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    For i = 2 To SonSat
        sira = Application.Match(Cells(i, "E"), Application.Transpose(Rutbe), 0)
        Cells(i, SonKol) = sira
    Next i
    
    Range(Cells(2, 2), Cells(SonSat, SonKol)).Sort Key1:=Cells(1, SonKol), Key2:=Range("F1"), Key2:=Range("F1")
    Columns(SonKol).Delete 'Shift:=xlToLeft
        
    Application.ScreenUpdating = True
    
    MsgBox "LİSTE; RÜTBE VE BİRİME GÖRE SIRALANMIŞTIR...", vbInformation, "TEŞEKKÜRLER "


'OptionButton4 Seçildiğinde aşağıdaki kod çalışsın.

ElseIf OptionButton4 = True Then
    
    Application.ScreenUpdating = False
    
    SonKol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    SonSat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    Range(Cells(2, 2), Cells(SonSat, SonKol)).Sort Key1:=Range("B1")
    Columns(SonKol).Delete 'Shift:=xlToLeft
        
    Application.ScreenUpdating = True
    
    MsgBox "PERSONEL LİSTESİ SİCİLE GÖRE SIRALANMIŞTIR...", vbInformation, "TEŞEKKÜRLER"

'OptionButton5 Seçildiğinde aşağıdaki kod çalışsın.

ElseIf OptionButton5 = True Then
    Application.ScreenUpdating = False
    
    SonKol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    SonSat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    Range(Cells(2, 2), Cells(SonSat, SonKol)).Sort Key1:=Range("F1")
    Columns(SonKol).Delete 'Shift:=xlToLeft
        
    Application.ScreenUpdating = True
    
    MsgBox "PERSONEL BİRİME GÖRE SIRALANMIŞTIR...", vbInformation, "TEŞEKKÜRLER"
End If
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]

 

[Hacı Bayram ÖZKAN]

Ömer bey, sıralamayı Personel sayfasından yapacak şuan Liste sayfasından yapıyor, birde seçim yapmayınca mesaj verecekti, buna bakar mısın? Teşekkürler.