Kayıt Süresince "Bekleyiniz" İfadesi

[1Al2Ver]

Merhaba,

Aşağıda kod aktarma işlevini yaparken ekranda "Kayıt Devam Ediyor, Lütfen Bekleyiniz" uyarısını almayı, kayıt bittiğinde de ekrandan kalkmasını arzuluyorum.

Gerekli ilaveyi rica ediyorum.

Teşekkür ederim.

Sub aktar()
Dim son1
Dim son2
Dim a
Dim b

For a = 3 To 20
son1 = Sheets("OYUNCU_TABLO").Cells(Rows.Count, 1).End(3).Row
For b = 4 To 17
    If Sheets("MAÇ_KAYIT").Cells(a, 3) <> "" Then
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, b + 1) = Sheets("MAÇ_KAYIT").Cells(a, b)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, 1) = Sheets("MAÇ_KAYIT").Cells(a, 1)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, 3) = Sheets("MAÇ_KAYIT").Cells(a, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, 2) = Sheets("MAÇ_KAYIT").Cells(2, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "d") = Sheets("MAÇ_KAYIT").Cells(21, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "s") = Sheets("MAÇ_KAYIT").Cells(22, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "t") = Sheets("MAÇ_KAYIT").Cells(23, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "u") = Sheets("MAÇ_KAYIT").Cells(24, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "v") = Sheets("MAÇ_KAYIT").Cells(25, 3)
       Sheets("OYUNCU_TABLO").Cells(son1 + 1, "w") = Sheets("MAÇ_KAYIT").Cells(26, 3)
       End If
       Next
       Next
       Sheets("MAÇ_KAYIT").Cells(2, 2).Select
        soru = "Mevcut kaydı silmek istediğinizden emin misiniz?"
        cevap = MsgBox(soru, vbYesNo + vbQuestion)
        Select Case cevap
            Case vbYes
           Sheets("MAÇ_KAYIT").Range("d3:q20").ClearContents
           Sheets("MAÇ_KAYIT").Range("c2:c24").ClearContents
           Sheets("MAÇ_KAYIT").Range("c26").ClearContents
            Case vbNo
                Exit Sub
        End Select
      
End Sub

 

[cems]

İşlem süresi bu kodlarla 1 yada 2 saniye alabilir. Bir fikir olarak :

Sadece zaman göstergesi taşıyan ve altında istediğiniz ifadenin bulunduğu bir mini userformu varolan işlem üzerine açıp zaman dolunca da kendiliğinden kapanmasını sağlayabilirsiniz.

Bu kodları Dim lerden sonra ekleyin ve deneyin

Userform2.show
Application.Wait Now + TimeValue("00:00:02")
Unload Me

 

[1Al2Ver]

Sayın cems merhaba,

Birşeyler denedim ancak başaramadım, sanırım çözümü anlayamadım.

Çözümü, aşağıdaki linkte 2 nolu mesaj ekindeki dosyaya uygularsanız memnun olurum,

Teşekkür ederim.

https://www.excel.web.tr/threads/veri-aktarma-farkli-sayfaya-alt-alta.178600/

 

[cems]

Bir userform ve üzerine de ilerleme çubuğu ekledim.
Bu userformun aktif olduğu anda çalışmaya başlamasını kendi içindeki kodlarla sağladım.
Sizin aktarma tuşunuz içinde kodlarınızın üst kısmında userformu çağırdım.
İlerleme 100 e ulaştığında aynı kodların altına userformu kapat kodu ekledim.

Aktarma işlemini incelemedim , zira o kodların çalışması 1 2 saniye alır , aynı hızda bir görsel
flash olacağından hoş durmazdı. Bu şekilde aktarma zamanı değil görsel ve akışını izletmek
daha hoş durabilir.

Bu userform kendiliğinden kapandığında altında silme mesajı geliyor , neden ve nereden
geldiğini incelemedim, sadece " bekleyiniz " formunu ekledim . Diğer işlemler veya bu userformun
dizaynı konusunda siz kendi ayarlamalarınızı yaparsınız. Ben bekletmenin yerini uyduramamış olabilirim.
Siz mevcut kaydı sildikten sonra çalışsın istiyorsanız kod içindeki userform1.show kodunun yerini
ona göre değiştirin

Kodlarınızda End sub dan bir önce Thisworkbook.save ekleyin ki son hali otomatik kaydetsin, yoksa
excelden çıkarken kaydedeyim mi diye sorar.

Dosyanız , deneyin ..

 

[Ömer BARAN]

Merhaba.
Userform vs kullanmak yerine, kod'un başına ve sonuna eklenecek basit birer kod satırı ile;
-- istenilen bir hücreye, başlangıçta "BEKLEYİNİZ" metnini yazdırıp, işlem sonrasında da bu metni sildirmeyi,
-- ya da önceden hazırlayacağınız ve içerisinde BEKLEYİNİZ metni olan bir METİN KUTUSU olup, bu metin kutusunun
VISIBLE özelliğini başlangıçta TRUE, işlem sonunda da FALSE yapmayı,
neden düşünmüyorsunuz.

Ekteki belgede işlem için METİN KUTUSU kullandım, deneyiniz.
Kod'da Sayın @cems 'in de belirttiği Application.Wait kullandım, zira kodun yapacağı işlem zaman alıcı bir işlem değil.
Kendi aktarma kodlarınız zaman alıyorsa ...Wait kod satırları silinebilir elbette.
Kodlar Module1'de.

 

[1Al2Ver]

Merhaba,

Sayın cems,
Sayın Baran,

Çözüm ve önerileriniz için teşekkür ederim,

Saygılarımla.

 

[halit3]

Alternatif kod

Sub basla()

Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Textbox.1")
With Obj
.Left = 321
.Top = 94
.Height = 102
.Width = 293
.PrintObject = False
.Name = "Text1"
End With

With Obj.Object
.BackColor = 255
.Font.Size = 28
.Font.Bold = True
.Text = "Lütfen Bekleyiniz."
.ForeColor = -2147483643
End With

Dim basla
Dim bekle
basla = Timer
bekle = 1
While Timer < basla + bekle
DoEvents
Wend

Call aktar 'makro kodunuz

ActiveSheet.Shapes("Text1").Delete
basla = Timer
bekle = 1
While Timer < basla + bekle
DoEvents
Wend
MsgBox "işlem tamam"
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Alternatif kod ve ilginiz için teşekkür ederim,

Saygılarımla.

 

[halit3]

Sayın halit3 merhaba,

Alternatif kod ve ilginiz için teşekkür ederim,

Saygılarımla.

Teşekkürler iyi akşamlar