Benim istediğim adete göre makronun tekrarlanması.

Katılım
15 Haziran 2005
Mesajlar
40
Mrb,

Kod:
Sub Tekrarla()
Dim i, Kac_Kere As Integer
i = 1
Kac_Kere = 5
Do While i <= Kac_Kere
    MsgBox "Bu mesaj " & Kac_Kere - i & " kere daha karşınız gelecek", vbCritical, "Deneme"
    i = i + 1
Loop
End Sub
 
Katılım
20 Ocak 2007
Mesajlar
112
Excel Vers. ve Dili
excel-2003 türkçe
Merhaba,

Yukarıdaki kodu aşağıdaki koda nasıl uygulayacağız. Aşağıdaki kodun mesela 40 defa tekrarlanmasını istiyorum.

Kod:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Sheets("örnek-2").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Sheets("örnek-1").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Sheets("BİLGİLERİ BURAYA GİRİN").Select
    Application.ScreenUpdating = False
    Range("AL7:AN7").Select
    If [al7] < 41 Then [al7] = [al7] + 1
    Sheets("BİLGİLERİ BURAYA GİRİN").Select
    Range("AL2:AN2").Select
End Sub
 

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,651
Excel Vers. ve Dili
Excel : 2010
Bu şekilde de kullanılabilir.

Sub Düğme1_Tıklat()
For s = 1 To 5
MsgBox (s) & " " & "Excel.Web.tr"
Next
End Sub
 
Katılım
20 Ocak 2007
Mesajlar
112
Excel Vers. ve Dili
excel-2003 türkçe
Merhaba,

Verdiğiniz kodu benim verdiğim kodun neresine uygulamam gerekiyor.

CommandButton'a bastığım zaman, CommandButton'daki kodun 40 defa tekrarlanmasını istiyorum.
 

Mahmut Bayram

Özel Üye
Katılım
25 Haziran 2005
Mesajlar
1,778
Excel Vers. ve Dili
2016 Excel Tr
Kodlar&#305;n&#305;z&#305; buraya yazar m&#305;s&#305;n&#305;z.
 
Katılım
20 Ocak 2007
Mesajlar
112
Excel Vers. ve Dili
excel-2003 türkçe
Kodlarınızı buraya yazar mısınız.
Daha önce yazmıştım ama, tekrar yazıyorum.

Kod:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Sheets("örnek-2").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Sheets("örnek-1").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Sheets("BİLGİLERİ BURAYA GİRİN").Select
    Application.ScreenUpdating = False
    Range("AL7:AN7").Select
    If [al7] < 41 Then [al7] = [al7] + 1
    Sheets("BİLGİLERİ BURAYA GİRİN").Select
    Range("AL2:AN2").Select
End Sub
 
Üst