MsgBox kutusunu çalıştıramıyorum...

[akselgonzales]

Merhabalar;

En alta eklediğim makro kodu tamamlandığında,

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", , "Başlık Burada Gözüküyor"
End Sub
Bu yukarıda görmüş olduğunuz mesaj kutusunu çalıştırmak istiyorum ama işlem tamamlandığında bir türlü mesaj kutusu çalışmıyor. Makro kodu çalışıyor hata vermiyor ama bu mesaj kutusu çıkmıyor. Nasıl ve neden olduğunu anlamadım yardımcı olabilir misiniz?

Option Explicit
Sub Otomatik_Sayı_Üret()

Dim Csf As Worksheet: Set Csf = Worksheets("Yatay Kolonlar")
Dim snlSat() As String, snlsatTemp() As String
Dim data As Variant
Dim i%, ii%, iStn%, iStr%, lngSnsNo1&, lngSnsNo0&, lngSnsNo2&, lngSnsNo10&, lngSnsNo20&, lngSnsNo12&
With Csf
With .Range(.Cells(3, 20), .Cells(17, 1019))
.Clear
With .Font
.Name = "Courier New"
.Size = 8
.Bold = True
.Color = vbBlack
End With
End With
For iStr = 3 To 17
lngSnsNo1 = .Cells(iStr, 7) 'kaç adet 1 yerleşeceğini öğrendik.
lngSnsNo0 = .Cells(iStr, 8) 'kaç adet 0 yerleşeceğini öğrendik.
lngSnsNo2 = .Cells(iStr, 9) 'kaç adet 2 yerleşeceğini öğrendik.
lngSnsNo10 = .Cells(iStr, 10) 'kaç adet 2 yerleşeceğini öğrendik.
lngSnsNo20 = .Cells(iStr, 11) 'kaç adet 2 yerleşeceğini öğrendik.
lngSnsNo12 = .Cells(iStr, 12) 'kaç adet 2 yerleşeceğini öğrendik.
If (lngSnsNo1 + lngSnsNo0 + lngSnsNo2 + lngSnsNo10 + lngSnsNo20 + lngSnsNo12) <> 1000 Then
MsgBox "Değerler toplamı 1000 olmalıdır.", 16, "DİKKAT"
Range(.Cells(iStr, 7), .Cells(iStr, 12)).Select
Exit Sub
End If
'/// 2 ila 16 sütunlar arasında döngü başlattık.
For iStn = 20 To 1019
i = i + 1
ReDim Preserve snlSat(1 To i)
snlSat(i) = .Cells(iStr, iStn).Address ' ve Adreslieri diziye aldık.
Next iStn
'/// 1 şans numarası olarak oynanmışsa
If lngSnsNo1 > 0 Then
data = UniqueRandomNumbers(lngSnsNo1, 1, UBound(snlSat)) 'kaçadet1 yerleşecek, başlangıç no, bitiş no
For i = 1 To lngSnsNo1 'yerleştime işlemine başladık.
.Range(snlSat(data(i))).Value = 1 'kura sonucu belirlenen numara sanal satırımızdaki ahngi adrese karşılık geliyorsa ona yazıyoruz.
snlSat(data(i)) = Empty 'tekrar kullanmamak içöini boşaltıyoruz.
Next i
For i = LBound(snlSat) To UBound(snlSat) 'Kullandıklarımızı diziden çıkartıp geçici diziye alacağzı, sonra gerçek dizimize geri vereceğiz.
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If
'' Stop
'/// 0 şans numarası olarak oynanmışsa
If lngSnsNo0 > 0 Then
data = UniqueRandomNumbers(lngSnsNo0, 1, UBound(snlSat))
For i = 1 To lngSnsNo0
.Range(snlSat(data(i))).Value = 0
snlSat(data(i)) = Empty
Next i
For i = LBound(snlSat) To UBound(snlSat)
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If

'/// 10 şans numarası olarak oynanmışsa
If lngSnsNo10 > 0 Then
data = UniqueRandomNumbers(lngSnsNo10, 1, UBound(snlSat))
For i = 1 To lngSnsNo10
.Range(snlSat(data(i))).Value = 10
snlSat(data(i)) = Empty
Next i
For i = LBound(snlSat) To UBound(snlSat)
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If

'/// 20 şans numarası olarak oynanmışsa
If lngSnsNo20 > 0 Then
data = UniqueRandomNumbers(lngSnsNo20, 1, UBound(snlSat))
For i = 1 To lngSnsNo20
.Range(snlSat(data(i))).Value = 20
snlSat(data(i)) = Empty
Next i
For i = LBound(snlSat) To UBound(snlSat)
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If

'/// 12 şans numarası olarak oynanmışsa
If lngSnsNo12 > 0 Then
data = UniqueRandomNumbers(lngSnsNo12, 1, UBound(snlSat))
For i = 1 To lngSnsNo12
.Range(snlSat(data(i))).Value = 12
snlSat(data(i)) = Empty
Next i
For i = LBound(snlSat) To UBound(snlSat)
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If

'/// 2 şans numarası olarak oynanmışsa
If lngSnsNo2 > 0 Then
data = UniqueRandomNumbers(lngSnsNo2, 1, UBound(snlSat))
For i = 1 To lngSnsNo2
.Range(snlSat(data(i))).Value = 2
snlSat(data(i)) = Empty
Next i
For i = LBound(snlSat) To UBound(snlSat)
If snlSat(i) <> Empty Then
ii = ii + 1
ReDim Preserve snlsatTemp(1 To ii)
snlsatTemp(ii) = snlSat(i)
End If
Next i
i = 0: ii = 0
snlSat = snlsatTemp
Erase snlsatTemp(), data
End If
Erase snlSat()
'diğer satırı dolduracağız.
Next iStr
End With
Set Csf = Nothing
End Sub
Function UniqueRandomNumbers(KacAdetSayi As Long, EnKucukSayi As Long, EnBuyukSayi As Long) As Variant
' creates an array with NumCount unique long random numbers in the range LLimit - ULimit (including)
'Kullanımı Aşağıdaki gibidir
'Bir değişkene = (
'Data = UniqueRandomNumbers(6, 1, 49)
Dim RandColl As Collection, varTemp() As Long
Dim k&, i&, j&
UniqueRandomNumbers = False

If KacAdetSayi < 1 Then Exit Function
If EnKucukSayi > EnBuyukSayi Then Exit Function
If KacAdetSayi > (EnBuyukSayi - EnKucukSayi + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (EnBuyukSayi - EnKucukSayi) + EnKucukSayi)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = KacAdetSayi

ReDim varTemp(1 To KacAdetSayi)

For i = 1 To KacAdetSayi
varTemp(i) = RandColl(i)
Next i
'**********************************
For i = 1 To KacAdetSayi - 1
For j = i + 1 To KacAdetSayi
If varTemp(i) > varTemp(j) Then
'Switch(varTemp(i),varTemp(j))
k = varTemp(i)
varTemp(i) = varTemp(j)
varTemp(j) = k
End If
Next j
Next i
'**********************************
Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
k = 0: i = 0: j = 0
'****************
End Function

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Makronuzun en sonundaki End Sub satırından önce MsgBox "Vermek istediğimiz mesaj", , "Başlık Burada Gözüküyor" satırı yerleştirin.
Kolay gelsin

 

[akselgonzales]

Hocam, bu makro başlatıldığında bir döngü başlatıyor, dediğiz yere end sub satırından önceki alana yerleştirdiğinde önce bu mesajı yayınlıyor, sonrasında her döndüyü tamamladığında tekrar bu mesajı yayınlıyor. yani aslında bu makroyu çalıştırdığımda 20 dk sonra bütün döngüleri tamalayıp gerekli alanlara rastgele sayıları doldurup sonrasında işlemi tamamlıyor. bu işlemleri tamamladıktan sonra bu mesajı almak istiyorum. bunu çözemedim yardımcı olabilirsen sevinirim.