Makro bitene kadar hareketli bekleme barı

[haso_excel]

Mehaba arkadaşlar,

Ekdeki dosyamda ki kodlar çalışırken, userinde bir bar olan bir userform ekranda belirecek ve makro çalıştıkça bar sona doğru hareket edecek ve sona geldiğinde de işlem bitecek. Bu işlem nasıl olacak acaba.

 

[uzmanamele]

merhaba

progresbar diye sitede arama yapınız.

 

[haso_excel]

Üstadım dediğiniz gibi araştırdım ama herhelde çok eski konular ki, ekli hiç bir dosya açılmıyor.

 

[haso_excel]

Ben yapmaya çalıştım fakat olmadı dosyam ekte rica etsem yardımcı olur musunuz?

 

[zafer]

Merhaba


Ekli dosyaları inceleyiniz.

Yalnız makro çalışırken progressbar ilerleme yapmaz

 

[zafer]

Merhaba

Ekli dosyayı inceleyiniz.

3 adet progressbar kullanımı var
örnek:
dosya açmak için geçen zaman diliminde çalışan progressbar
dosyayı kaydederken çalışan progressbar

Makro ile ilgili olduğunuz için kodları kendiniz inceleyebilirsiniz düşüncesiyle dosyaya açıklama yazmadım

 

[haso_excel]

Sub format()
Rows("1:7").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("A:B").EntireColumn.AutoFit
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:I").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("G:J").Select
Selection.Delete Shift:=xlToLeft
Columns("G:J").EntireColumn.AutoFit
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("I:M").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Range("A1").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
End Sub

Sub satirsil()
Dim sat As Integer
For sat = Cells(65536, "a").End(xlUp).Row To 2 Step -1
If Cells(sat, "a") <> 1000 Or Cells(sat, "a") = "" Then
Cells(sat, "a").EntireRow.Delete
End If
If Cells(sat, "c") = "" Then Cells(sat, "c") = "."
Range("a2:h" & sat).Sort Range("c2"), xlDescending
If Cells(sat, "c") = "." Then Cells(sat, "c") = " "
Next
Columns("D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "Hesap Adı"
Range("D2").Select
End Sub

Sub vlookup_1() 'sheet1 den
On Error Resume Next
For sut = 2 To WorksheetFunction.CountA(Range("C:C"))
'For sut = 1 To 6
Range("D" & sut) = WorksheetFunction.VLookup(Range("C" & sut), Sheets("HES_PLAN").Range("a:B"), 2, 0)
Next
Exit Sub
'hata:
'MsgBox "c sütununda verisiz hücreyi doldurmalısınız."
End Sub
Sub RAPOR()
BEKLEME
format
satirsil
vlookup_1
MsgBox "İŞLEM TAMAM"
End Sub

Üstadım öncelikle ilginiz için çok teşekkür ederim. Örneklerinizi incelediğimde anladığım kadarı ile ya bir range yada bir time tanımlayıp progresbar çalışıyor. Benim de kodlarımdan anlayacağınız üzere 3 adet prosedürüm var. Ben bunları Rapor adında ayrı bir prosedüre bağlayıp sırası ile çalıştırıyorum.

Sub RAPOR()
BEKLEME
format
satirsil
vlookup_1
MsgBox "İŞLEM TAMAM"
End Sub

Allayamadığım tarafı ben her prosedürün ne kadar zaman çalışacağını bilmediğim için bunu progres barda nasıl çalıştıracağım.

 

[uye947]

eline sağlık

eline sağlık güzel olmuş