- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
rica ederim.Hüseyin Bey,
Tebrikler, Elinize sağlık güzel bir çalışma olmuş.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
rica ederim.Hüseyin Bey,
Tebrikler, Elinize sağlık güzel bir çalışma olmuş.
Ekteki dosyadan faydalanabilirsiniz.
benim yapmış olduğum uygulamayı 5 kelimeden az olmamak kaydıyla kullanabilirsiniz.merhaba
yine rahatsız ediyorum kusuruma bakmayın lütfen. gönderdiğiniz dosyadaki çalışma şekli evdeki programa yakın. bu nedenle bende mevcut kelimeleri silip kendi kelimelerimi eklemek istedim ancak kelimeleri silince dosya çalışmadı. elimdeki kelimeleri 20 şer kalıplar halinde ezberliyorum. dosyanın ayarlamasının bu yönde yapılması mümkün mü?
eğer yardımcı olursanız çok sevinirim.
iyi çalışmalar
Denedim ama malesef bir yerde hata yapıyorum galiba. Baştan itibaren 10 kadar kelime bırakıyorum gerisini siliyorum. Diğer sayfaya geçip kelime getir'e ve doğru cevap'a bastığımdaşöyle bir görüntü oluşuyor.benim yapmış olduğum uygulamayı 5 kelimeden az olmamak kaydıyla kullanabilirsiniz.
ben 11.mesaj ekindekinden bahsetmiştim.Denedim ama malesef bir yerde hata yapıyorum galiba. Baştan itibaren 10 kadar kelime bırakıyorum gerisini siliyorum. Diğer sayfaya geçip kelime getir'e ve doğru cevap'a bastığımdaşöyle bir görüntü oluşuyor.
özür dilerim karıştırdım galiba.ben 11.mesaj ekindekinden bahsetmiştim.
bu tabloyu sonradan gördüm...ben birşey sormak istiyorum....soru kökü olarak A sütununu doğru cavap olarak B sütununu alıyor...diğer seçenekler B sütunundaki kelimelerden otomatik olarak geliyor.Soru seçeneklerini biz kendimiz girsek (B-C-D ve E sütunlarına) ve B sütunu hep doğru şık olsa...Userformda yine seçenekler karışarak gelsek ve de programdan çıkmak istediğimizde o ana kadar çözümlenen sorulardan doğru yanlış sayısını en sonunda bize aktarsa...Örneğin: "...... adet soru çözdünüz , ..... doğru , ..... yanlış cevap verdiniz." gibi....iki kelime havuzundan faydalanarak aşağıdaki dosyayı elde ettim.
önce kodlar
userforma
moduleKod:Option Explicit Private strTrkKelime As String Private iCvpKont As Integer Private Sub cmdCevap1_Click() Call cevapKontrol(1) End Sub Private Sub cmdCevap2_Click() Call cevapKontrol(2) End Sub Private Sub cmdCevap3_Click() Call cevapKontrol(3) End Sub Private Sub cmdCevap4_Click() Call cevapKontrol(4) End Sub Private Sub cmdCevap5_Click() Call cevapKontrol(5) End Sub Private Sub cevapKontrol(i) If Controls("cmdCevap" & i).Caption = strTrkKelime Then MsgBox "Tebrikler, Doğru Cevap" Call ingilizce_Türkçe Else MsgBox "Üzgünüm, Yanlış Cevap < " & 2 - iCvpKont & " > Tahmin Hakkınız kaldı" iCvpKont = iCvpKont + 1 If iCvpKont = 3 Then Call ingilizce_Türkçe End If End Sub Private Sub UserForm_Initialize() Call ingilizce_Türkçe End Sub Private Sub ingilizce_Türkçe() Dim Csf As Excel.Worksheet: Set Csf = Worksheets("Sozluk") Dim dataEngKelime As Variant, dataTrkKelimeler As Variant, dataButonNo As Variant Dim Sonsat As Long, lngSmdEngInd As Long, lngOncEngInd As Long Dim i As Integer '\\ Kontrolleri Sıfırlıyoruz iCvpKont = 0 lblSoru.Caption = "" lblOkunus.Caption = "" For i = 1 To 5 Controls("cmdCevap" & i).Caption = "" Next i '\\ Havuzdan değerleri alıyoruz. With Csf Sonsat = .Cells(65536, 1).End(3).Row dataEngKelime = BenzersizRastgeleSayilar(1, 2, Sonsat, enCevapHayır) lngSmdEngInd = dataEngKelime(1) strTrkKelime = .Cells(lngSmdEngInd, 2).Value lblSoru.Caption = .Cells(lngSmdEngInd, 1).Value lblOkunus.Caption = .Cells(lngSmdEngInd, 3).Value CevaplarıHazırla: dataTrkKelimeler = BenzersizRastgeleSayilar(4, 1, Sonsat, enCevapHayır) For i = LBound(dataTrkKelimeler) To UBound(dataTrkKelimeler) If dataTrkKelimeler(i) = lngSmdEngInd Then GoTo CevaplarıHazırla If dataTrkKelimeler(i) = lngOncEngInd Then GoTo CevaplarıHazırla Next i CevaplarıYaz: dataButonNo = BenzersizRastgeleSayilar(4, 1, 5, enCevapHayır) For i = LBound(dataButonNo) To UBound(dataButonNo) Controls("cmdCevap" & dataButonNo(i)).Caption = .Cells(dataTrkKelimeler(i), 2).Value Next i For i = 1 To 5 If Controls("cmdCevap" & i).Caption = "" Then Controls("cmdCevap" & i).Caption = strTrkKelime Next i End With lngOncEngInd = lngSmdEngInd End Sub
Kod:Public Enum enCevap enCevapevet enCevapHayır End Enum Function BenzersizRastgeleSayilar(KacAdetSayi As Long, EnKucukSayi As Long, EnBuyukSayi As Long, Optional Sıralımı As enCevap) As Variant 'Benzersiz Rastgele Sayılar Üretir. 'Kullanımı Aşağıdaki gibidir 'Data = UniqueRandomNumbers(6, 1, 49) Dim RandColl As Collection, varTemp() As Long Dim k&, i&, j& BenzersizRastgeleSayilar = 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 Set RandColl = Nothing If Sıralımı = enCevapevet Then '**************ripek******************** For i = 1 To KacAdetSayi - 1 For j = i + 1 To KacAdetSayi If varTemp(i) > varTemp(j) Then k = varTemp(i) varTemp(i) = varTemp(j) varTemp(j) = k End If Next j Next i '**************ripek******************** End If BenzersizRastgeleSayilar = varTemp Erase varTemp k = 0: i = 0: j = 0 '*****www.excel.web.Tr*********** End Function