cocoa35
Altın Üye
- Katılım
- 6 Eylül 2007
- Mesajlar
- 652
- Excel Vers. ve Dili
- excel 2016 32 Bit ve Excel 2020 32 Bit Türkçe ve İngilizce
Merhaba, Aşağıda ekli olan kodlara Progressbar eklemek istiyorum ancak tam olarak çalışmıyor. Kodlarda nerde hata yapıyorum acaba?
Private Sub CommandButton1_Click()
Worksheets("PID1").Unprotect "12345"
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
For i = 1 To 100
x = x + 1
Bar3.Width = x * 2.3
Barlbl.Caption = "% " & Int(x / 100 * 57)
DoEvents
Set S1 = Sheets("PID1")
Set S2 = Sheets("HESAPLAR")
Set S3 = Sheets("PROSES HESAP KOD")
Application.ScreenUpdating = False
S1.Rows("79:117").EntireRow.Hidden = False
S1.Rows("352:390").EntireRow.Hidden = False
S1.Rows("391:429").EntireRow.Hidden = False
S1.Rows("430:468").EntireRow.Hidden = False
S1.Rows("469:507").EntireRow.Hidden = False
S1.Rows("508:546").EntireRow.Hidden = False
If S2.[H383] = 2 Then
S1.Rows("79:117").EntireRow.Hidden = True
End If
If S3.[I126] = 2 Then
S1.Rows("391:429").EntireRow.Hidden = True
S1.Rows("430:468").EntireRow.Hidden = True
S1.Rows("469:507").EntireRow.Hidden = True
S1.Rows("508:546").EntireRow.Hidden = True
End If
If S3.[I128] = 2 And S3.[I131] = 1 Then
S1.Rows("352:390").EntireRow.Hidden = True
End If
If S3.[I126] = 1 And S3.[N144] = 2 Then
S1.Rows("469:507").EntireRow.Hidden = True
End If
Next i
MsgBox "İşlem tamam"
Unload Me
Worksheets("PID1").Protect "12345"
End Sub
Private Sub CommandButton1_Click()
Worksheets("PID1").Unprotect "12345"
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
For i = 1 To 100
x = x + 1
Bar3.Width = x * 2.3
Barlbl.Caption = "% " & Int(x / 100 * 57)
DoEvents
Set S1 = Sheets("PID1")
Set S2 = Sheets("HESAPLAR")
Set S3 = Sheets("PROSES HESAP KOD")
Application.ScreenUpdating = False
S1.Rows("79:117").EntireRow.Hidden = False
S1.Rows("352:390").EntireRow.Hidden = False
S1.Rows("391:429").EntireRow.Hidden = False
S1.Rows("430:468").EntireRow.Hidden = False
S1.Rows("469:507").EntireRow.Hidden = False
S1.Rows("508:546").EntireRow.Hidden = False
If S2.[H383] = 2 Then
S1.Rows("79:117").EntireRow.Hidden = True
End If
If S3.[I126] = 2 Then
S1.Rows("391:429").EntireRow.Hidden = True
S1.Rows("430:468").EntireRow.Hidden = True
S1.Rows("469:507").EntireRow.Hidden = True
S1.Rows("508:546").EntireRow.Hidden = True
End If
If S3.[I128] = 2 And S3.[I131] = 1 Then
S1.Rows("352:390").EntireRow.Hidden = True
End If
If S3.[I126] = 1 And S3.[N144] = 2 Then
S1.Rows("469:507").EntireRow.Hidden = True
End If
Next i
MsgBox "İşlem tamam"
Unload Me
Worksheets("PID1").Protect "12345"
End Sub