Believing
Altın Üye
- Katılım
- 19 Mayıs 2013
- Mesajlar
- 700
- Excel Vers. ve Dili
-
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
- Altın Üyelik Bitiş Tarihi
- 23-08-2028
Sayın Uzman Arkadaşlar,
Çalışma kitabımda ToggleButton1 ile "A18:A1000" aralığındaki boş satırları gizle/göster yapıyor, ToggleButton2 ile "A18:C1000" aralığındaki ise "A,B,C" sütunlarını gizle/göster yapıyorum.
Aşağıdaki kodlar ile yaptığım bu işlemi tek bir Toggle Button ile yapabilmek için, mevcut kodlarda nasıl değişiklik yapmalıyım.
Benim için çok kıymetli olan yardımlarınızı rica ediyorum.
Saygılarımla,
Ömer Ali ÜZÜMCÜ
Çalışma kitabımda ToggleButton1 ile "A18:A1000" aralığındaki boş satırları gizle/göster yapıyor, ToggleButton2 ile "A18:C1000" aralığındaki ise "A,B,C" sütunlarını gizle/göster yapıyorum.
Aşağıdaki kodlar ile yaptığım bu işlemi tek bir Toggle Button ile yapabilmek için, mevcut kodlarda nasıl değişiklik yapmalıyım.
Kod:
Private Sub ToggleButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ToggleButton1.BackColor = vbYellow
If ToggleButton1 = True Then
ToggleButton1.Caption = "Yardımcı Sütunları GÖSTER"
Range("A18:C1000").EntireColumn.Hidden = True
ToggleButton2.Visible = True
Else
ToggleButton1.BackColor = vbRed
ToggleButton1.Caption = "Yardımcı Sütunları GİZLE"
Range("A18:C1000").EntireColumn.Hidden = False
ToggleButton2.Visible = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Private Sub ToggleButton2_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Veri As Range, Alan As Range
ToggleButton2.BackColor = vbBlue
For Each Veri In Range("A18:A1000")
If Veri.Value = "" Then
If Alan Is Nothing Then
Set Alan = Veri
Else
Set Alan = Union(Alan, Veri)
End If
End If
Next
If Not Alan Is Nothing Then
With ToggleButton2
If .Value Then
Alan.EntireRow.Hidden = True
.Caption = "Boş Satırları GÖSTER"
Else
ToggleButton2.BackColor = vbGreen
Alan.EntireRow.Hidden = False
.Caption = "Boş Satırları GİZLE"
End If
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Saygılarımla,
Ömer Ali ÜZÜMCÜ