Soru Sayfayı kopyalarken Progressbar ekleme?

[mars2]

İyi günler;
Aşağıdaki kodla tabloyu kopyala-yapıştır yapmaktayım.
Düğme4 çalıştığında userform1 aktif hale gelsin ve userform1 üzerindeki prossbar çalışmasını istemekteyim.

Sub Düğme4_Tıkla()

Dim Time1 As Double, Time2 As Double
Dim timeElapsed As String

Dim Msg As String, Ans As Variant
Dim w As Workbook

Time1 = Now

Ans = MsgBox("Verileriniz Güncellenecek mi?", vbQuestion + vbYesNo, "Günceleme???")

Select Case Ans
Case vbYes

For Each j In Application.Workbooks
If j.Name = "LİSTE.xls" Then
Windows("LİSTE.xls").Activate
GoTo 10
End If
Next


Workbooks.Open Filename:="D:\Belgeler\LİSTESİ.xls", Password:="..."

dosyaaçıkmı = "hayır"
10:

Sheets("Liste").Select

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

MsgBox ActiveSheet.Name & Chr(13) & Chr(13) & " Sayfasını Açtınız", 1, ActiveSheet.Name

Range("A2:AG3000").Select

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Windows("BİLGİ FORMU.xls").Activate
Worksheets("kayyım").Visible = True

Sheets("sayfa2").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Selection.End(xlDown).Select

Windows("BİLGİ FORMU 2009 - 2024.xls").Activate

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True



Worksheets("sayfa2").Visible = False
Time2 = Now
timeElapsed = Format(Time2 - Time1, "hh:mm:ss") & " Saniye"

Call MsgBoxTimeout(0, "Verileriniz Güncellendi." & Chr(13) & Chr(13) & "İşlem Süresi: " & timeElapsed, "İsim Günceleme", vbInformation, 0, 4000)

If dosyaaçıkmı = "hayır" Then


Workbooks("LİSTESİ.xls").Close Savechanges:=False

dosyaaçıkmı = ""
End If
ThisWorkbook.Activate

End Sub

örnek olarak

PROGRESSBAR EKLEME

Arkadaşlar merhaba; Ek'te örnek dosyada bulunan KABLO1 Sayfasındaki Değişik POZ'ları filtreleyerek KABLO Sayfasına aktaran Makro bulunmaktadır. İsteğim bu makroya ProgressBar eklemek , ben uğraştım ancak beceremedim bu konuda yardımınıza ihtiyacım var, Teşekkürler.

excel.web.tr

linkinden faydalanmaya çalıştım.

Userfrom1 üstüne
1 adet label
1adet fram eklenmiştir.

For i = 2 To son
DoEvents
ProgressBar1.Value = (i / son) * ProgressBar1.Max
Label2.Caption = Int((i / son) * 100) & "% tamamlandı"

Next i

MsgBox " İşlem Tamamlanmıştır."

 

[Korhan Ayhan]

Merhaba,

ProgressBar nesnesi döngülü işlemler için daha uygundur.

Bu sebeple sizin bu nesne yerine bir userform üzerinde "İşleminiz sürüyor. Lütfen bekleyiniz...." şeklinde bir uyarı penceresi daha kullanışlı olacaktır.

 

[mars2]

Sayın Korhan Ayhan;

İlginiz ve öneriniz için teşekkürker.