Progressbar

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
 

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
Arkadaşlar bu konuda yardım lütfen, progressbar kod'larını nasıl düzenlemeliyim?
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,052
Excel Vers. ve Dili
Microsoft Office 2019 English
For i = 1 To 100
x = x + 1
Bar3.Width = x * 2.3
Barlbl.Caption = "% " i / 100* 100

DoEvents

dener misiniz
 

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
Sn. Trilenium Denedim olmadı dahası program kilitlendi. :(
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,052
Excel Vers. ve Dili
Microsoft Office 2019 English
For i = 1 To 100
x = x + 1
ProgressBar1.Width = x * 2.3
ProgressBar1 = i / 100 * 100
DoEvents
 

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
Konuya cevap yazan arkadaşlara teşekkür ediyorum ancak maalesef bu çözümler çalışmıyor. denedim hepsini başka çözüm açısından fikri olan varmı acaba?
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,225
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
Kodu inceleyin...

C#:
Private Sub CommandButton1_Click()
    Const msg1 = "İşlem tamam."
    Const msg2 = "Bir hata oluştu. Orj. hata mesajı:" & vbCrLf
   
    Worksheets("PID1").Unprotect "12345"

    On Error GoTo handler
   
    Application.ScreenUpdating = False
   
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, bWidth As Single, forCount As Integer
   
    bWidth = Bar3.Width ' Normal uzunlukta olduğu varsayıldı...
   
    Bar3.Width = 0
   
    forCount = 100
   
    For i = 1 To forCount
   
        Bar3.Width = bWidth * (i / forCount)
        Barlbl.Caption = "% " & Int(100 * (Bar3.Width / bWidth))
       
        DoEvents
       
        Set S1 = Sheets("PID1")
        Set S2 = Sheets("HESAPLAR")
        Set S3 = Sheets("PROSES HESAP KOD")
       
        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
       
        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
        If S3.[I126] = 1 And S3.[N144] = 2 Then S1.Rows("469:507").EntireRow.Hidden = True
       
    Next i
   
    Application.ScreenUpdating = True
   
handler:
    MsgBox IIf(Err.Number = 0, msg1, msg2 & Err.Description)
    Err.Clear
    Unload Me
    Worksheets("PID1").Protect "12345"
 
End Sub


.
 
Üst