Skip to main content

AccessTr.neT


4'lü Kod Üretmek

M_Kemal_Askeri
M_Kemal_Askeri
5
488

4'lü Kod Üretmek

Çözüldü #1
Herkese Merhabalar.
Türk Ulusunun kayıtsız şartsız egemenliğini perçinleyen Türkiye Büyük Millet Meclisinin açılışının yıldönümü ve Cumhuriyetimizin kurucusu Ulu Önder Gazi Mustafa Kemal Atatürk'ün çocuklarımıza ve ruhunda her zaman biraz da olsa çocukluğunu koruyanlara armağan ettiği, dünyada eşi benzeri bulunmayan 23 Nisan Ulusal Egemenlik ve Çocuk Bayramımız kutlu olsun.

Ekte gönderdiğim ve uzun bir süre önce yaptığım kod üretme uygulamasını başka bir uygulamamda kullanmak istiyorum. mevcut uygulamada 4'lü kod "HARF-HARF-RAKAM-HARF" şeklinde sabit bir formatta üretiliyor. Ben kullanıcıya kolaylık sağlamak maksadıyla kod formatını değişken hale getirmek istiyorum. Bu maksatla ekteki örnekte iki adet Kod Üretim Formu koydum. İlk form "KODGRUBUURET" yukarıda bahsettiğim sabit formatta 4'lü Kod üretiyor. İkinci form "KODGRUBUURET_Yeni" ise değişken formatta kod üretmek için yapıldı. 1. form Module1'i kullanıyor, 2. form ise KODGRUBUURET fonksiyonunu VBA'sında barındırıyor. Bu fonksiyonda ben h1 ve h2 adında iki ayrı ifade tanımladım ve bu h1 ve h2 yi de KODGRUBUURET_Yeni formunda 4 adet Combobox'ın satır kaynağına DEĞER LİSTESİ "h1, h2 olarak yazdım. Amacım bu comboboxlar vasıtasıyla h1 veya h2 seçerek kodun formatını değiştirebilmek idi ama maalesef şu hatayı "Invalid call procedure or argument" verdi. Yardıma ihtiyacım var. teşekkür ederim.
Saygılarımla........
.rar 4GRUPLUKOD_URETOrnek.rar (Dosya Boyutu: 31,32 KB | İndirme Sayısı: 6)
NE MUTLU TÜRK'ÜM DİYENE
Cevapla
#2
örenkle vererek biraz daha açıklar mısınız?
girdiler ne olunca butona bastığımızdaki çıktı ne olmalı?
Cevapla
#3
Günaydın sayın Berduş,
Bu uygulamada KODGRUBUURET_Yeni formunda h1 ve h2 değerleri ile Module1'deki J değerleri sabit.
Yani
h1 her zaman h1 = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)

h2 her zaman h2 = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)

Module1'deki J değerleri de her zamanHARF-HARF-RAKAM-HARF şeklinde kod veriyor. Yani AA1B, CQ3W gibi. Kod miktarını ise her iki formda da bulunan Başlangıç ve Bitiş alanlarına kaç tane Kod üretmek istersek onu girerek belirliyorum. 1-20 mesela.

j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)

j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)

j = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)

j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)

Bu J sıralaması her zaman sabit olarak HARF-HARF-RAKAM-HARF şeklinde kod üretiyor.

Ayrıca bu ifadelerde geçen strSource (RAKAM) ve strSource1 (HARF) değerleri de sabit. Buraya kadar herhangi bir değişiklik yok.

Bu uygulamada KODGRUBUURET formunun VBA'sındaki J'lerin sıralanışı hiç değişmiyor ve bana butona her basışımda HARF-HARF-RAKAM-HARF sırası ile kod üretiyor.

Benim asıl yapmak istediğim ise Module1'deki J'lerin sabit sıralanışını bir şekilde değiştirmek.
Module1 üzerinden sıralamayı değiştirmek benim için zor olduğundan ben KODGRUBUURET_Yeni formunu yaptım ve Module1'deki prosedürü doğrudan bu formun VBA'sına yazdım. Bu formun VBA'sındaki prosedürde de J sıralanışını J=KSec1, J=KSec2, J=KSec3, J=KSec4 şeklinde yazdım. Bu sıralanış da sabit kalacak ama dikkat ederseniz buradaki prosedürde HARF-HARF-RAKAM-HARF sıralanışı olmayacak ve her bir J değerini karşısındaki combobox (KSec1,2,3,4)'lerden alacak. İşte ben de buna göre J değerlerini KSec1, KSec2, KSec3, KSec4 comboboxlarından h1 veya h2 seçerek belirleyeyim, kod da ona göre çıksın istiyorum. Ben Comboboxlardan h1-h2-h1-h1 seçersem kod A2B3 gibi, eğer h1-h1-h1-h2 seçersem kod GYX3 gibi olsun. Harfler ve rakamlar zaten strSource ve strSource1den RANDOM olarak seçiliyor. Sadece formdaki comboboxlardan seçilen h1 ve h2'ler değişecek.

Sonuç olarak benim bir şekilde KSec1, KSec2, KSec3, KSec4 comboboxlarından seçeceğim h1 ve h2 değerlerini prosedürdeki J=KSec1, J=KSec2, J=KSec3, J=KSec4 ifadeleri ile ilişkilendirmem lazım ki 4'lü kodu üretebileyim.
Umarım biraz da açık yazabilmişimdirImg-grin
saygılarımla.
NE MUTLU TÜRK'ÜM DİYENE
Cevapla
#4
Merhaba Sayın @M_Kemal_Askeri

Öncelikle sizin de bayramınız kutlu olsun. Çok basit hali ile kodunuzu aşağıdaki ile değiştirip dener misiniz? İstediğiniz bu yönde ise geliştirelim.


On Error GoTo Err_KODGRUBUURET4
Dim i As Integer, j As Integer
Dim strSource As String
Dim strSource1 As String
Dim strTarget As String

'*** used with the RND() function to return
' a random number
Randomize

strSource = "12345678901234567890"
strSource1 = "ABCÇDEFGHIİJKLMNOÖPQRSŞTUÜVWXYZ"
strTarget = ""

For i = 1 To strlen

'*** select a character position at random
If KSec1 = "h1" Then j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)
Else: j = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)
End If

If KSec2 = "h1" Then j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)
Else: j = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)
End If

If KSec3 = "h1" Then j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)
Else: j = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)
End If

If KSec4 = "h1" Then j = Int((Len(strSource1) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource1, j, 1)
Else: j = Int((Len(strSource) - 1) * Rnd + 1)
strTarget = strTarget & Mid(strSource, j, 1)
End If

Next i

'*** when the Target String is complete, pass it back
KODGRUBUURET4 = strTarget

Exit_KODGRUBUURET4:
Exit Function

Err_KODGRUBUURET4:
MsgBox Err.Description
Resume Exit_KODGRUBUURET4
Cevapla
#5
Sayın atoykan problem çözülmüştür. Desteğiniz için çok teşekkür ederim. sağ olun var olsun. sağlıklı günler diliyorum.
Sayın berduş size de cok teşekkür ederim. sağ olun var olsun. sağlıklı günler diliyorum.
NE MUTLU TÜRK'ÜM DİYENE
Cevapla
#6
Rica ederim
Iyi calismalar
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task