checkbox eklenti arasında hangisi acaba sembol olarak
Vcard Düzenlemesi
Onay Kutusu diye bakın, gözünüzü seveyim daha checkbox ne onu bilmiyorsunuz 
Sn atoykan kaç adet onay kutusu eklemeliyim
Bir de ne yapmam gerektiğinde biraz daha açıklayıcı bilgi verebilir misin selamlar
Bir de ne yapmam gerektiğinde biraz daha açıklayıcı bilgi verebilir misin selamlar
Son Düzenleme: 24/01/2024, 15:02, Düzenleyen: access acemisi.
1 tane Sayın @access acemisi
Checkbox değeri 0 ise yani seçili değilse combobox seçimlerinize göre işlem yapsın aksi halde belirttiğim gibi grup tablonuzun ilk ve son idsini for - next döngüsünde i değişkeni için kullanıp (i=ilk_id to son_id gibi) her seçeneğe göre döngüyle vcardınızı oluşturun.
Ve lütfen sormadan önce bu konuları tek tek bir daha araştırın, checkbox nedir, döngü nedir, nasıl kullanılır vs. 2011'den beri konularınıza bakıyorum, bu kadar basit bir işlemi çözmek için gereken bilgiye çoktan sahip olmanız gerekirken sadece verilen cevaplar üzerinden kopyala yapıştır dışında bir gelişim göstermemişsiniz anlaşılan.
Checkbox değeri 0 ise yani seçili değilse combobox seçimlerinize göre işlem yapsın aksi halde belirttiğim gibi grup tablonuzun ilk ve son idsini for - next döngüsünde i değişkeni için kullanıp (i=ilk_id to son_id gibi) her seçeneğe göre döngüyle vcardınızı oluşturun.
Ve lütfen sormadan önce bu konuları tek tek bir daha araştırın, checkbox nedir, döngü nedir, nasıl kullanılır vs. 2011'den beri konularınıza bakıyorum, bu kadar basit bir işlemi çözmek için gereken bilgiye çoktan sahip olmanız gerekirken sadece verilen cevaplar üzerinden kopyala yapıştır dışında bir gelişim göstermemişsiniz anlaşılan.
Formunuza bir checkbox ekleyin ve chk_allgroups olarak adlandırın.
cmd_tumkayitlar_iki_click kodunuzu aşağıdakiyle değiştirin.
kodunuzda gerekli for - next döngüsü ile tüm gruplar için vcard oluşturma işlemi tanımlanmış durumdadır (sadece checkbox tikini açmanız yeterlidir seçeneklerden grup seçmeye gerek yoktur) , ayrıca kodunuzda recordsette kayıt yoksa hata verir buna ilişkin denetim de yoktu, onu da ekledim; hangi grupta kayıt oluşturulamadı uyarı verir.
Sizin konularınıza şahsen verdiğim son cevaptır, sadece ilgilenen başka insanlar fayda sağlasınlar diye kodu düzenledim. Sizin amacınız öğrenmek falan değil işinizi gördürmek; bu sebeple bir daha herhangi bir sorunuza şahsen ben cevap vermeyeceğim, bilginiz olsun.
cmd_tumkayitlar_iki_click kodunuzu aşağıdakiyle değiştirin.
Kod:
Private Sub cmd_tumkayitlar_iki_Click()
If Me.chk_allgroups = 0 Then
GoTo vcardpublish
Else
Dim RecordFound As Boolean
RecordFound = False
For i = 1 To 7
Me.secenek = i
vcardpublish:
Dim objStream
Dim VcardAdi, FileName, File, encode As String
Dim rst As DAO.Recordset
Dim image_bin() As Byte
Dim GSayi As Integer
VcardAdi = Format(Date, "ddmmyyyy") & "TumKayitlar.vcf"
FileName = CurrentProject.path & "\" & VcardAdi
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
GSorgum = "SELECT tbl_kisiler.secenek_bir, * FROM tbl_kisiler WHERE (((tbl_kisiler.secenek_bir)='" & Me.secenek & "'));"
Set rst = CurrentDb.OpenRecordset(GSorgum)
If Not rst.EOF Then
rst.MoveFirst
Me.etk_ilerle.Visible = True
GSayi = 0
Do Until rst.EOF
objStream.WriteText "BEGIN:VCARD" & vbCrLf
objStream.WriteText "VERSION:4.0" & vbCrLf
objStream.WriteText "N:" & rst!soyadi & ";" & rst!adisoyadi & ";" & rst!ikinciadi & ";" & rst!unvani & vbCrLf
objStream.WriteText "FN:" & rst!adisoyadi & " " & rst!soyadi & vbCrLf
objStream.WriteText "ORG:" & rst!sirketbilgisi & vbCrLf
objStream.WriteText "TITLE:" & rst!isunvani & vbCrLf
File = CurrentProject.path & "\resimler\" & rst!fotograf
If FileExists(File) = True Then
Open File For Binary Access Read As #1
ReDim image_bin(LOF(1) - 1)
Get #1, , image_bin
Close #1
encode = Replace(EncodeBase64(image_bin), vbLf, vbCrLf & Space(1))
objStream.WriteText "PHOTO;TYPE=JPEG;ENCODING=B:" & encode & vbCrLf
End If
objStream.WriteText "TEL;WORK;VOICE:" & rst!istelefonu & vbCrLf
objStream.WriteText "TEL;HOME;VOICE:" & rst!evtelefonu & vbCrLf
objStream.WriteText "TEL;CELL;VOICE:" & rst!ceptelefonu & vbCrLf
objStream.WriteText "ADR;WORK:" & rst!isadresi & ";" & rst!issehir & ";" & rst!ispostakodu & ";" & rst!isulke & vbCrLf
objStream.WriteText "ADR;HOME:" & rst!evadresi & ";" & rst!sehir & ";" & rst!evpostakodu & ";" & rst!evulke & vbCrLf
objStream.WriteText "CATEGORIES:" & DLookup("id_il", "il", "[id_il]= " & Nz(rst!sehir, 0)) & vbCrLf
objStream.WriteText "X-MS-OL-DEFAULT-POSTAL-ADDRESS:1" & vbCrLf
objStream.WriteText "EMAIL;PREF;INTERNET:" & rst!epostaadresi & vbCrLf
objStream.WriteText "URL;WORK:" & rst!websayfasi & vbCrLf
objStream.WriteText "NOTE:" & rst!notbir & vbCrLf
objStream.WriteText "NOTE:" & rst!notiki & vbCrLf
objStream.WriteText "NOTE:" & rst!notuc & vbCrLf
objStream.WriteText "REV:" & Format(Date, "yyyymmdd") & "T" & Format(Now(), "hhnnss") & "Z" & vbCrLf
objStream.WriteText "CATEGORIES:" & DLookup("grupadi", "grup", "[id_grup]= " & Nz(rst!secenek_bir, 0)) & vbCrLf
objStream.WriteText "END:VCARD" & vbCrLf
Me.etk_ilerle.Caption = rst!adisoyadi & " " & rst!soyadi
GSayi = GSayi + 1
rst.MoveNext
Loop
Me.etk_ilerle.Visible = False
objStream.SaveToFile FileName, 2
Me.etk_ilerle.Visible = False
MsgBox (GSayi & " adet veri " & VcardAdi & " isimli dosyaya kaydedildi")
rst.Close
objStream.Close
End If
Next i
If Not RecordFound Then
MsgBox UCase(DLookup("grupadi", "grup", "id_grup=" & Me.secenek.Value)) & _
" grubu için kayıt bulunamamıştır!", vbInformation + vbOKOnly, "Bulunmayan Kayıt"
End If
End If
End Subkodunuzda gerekli for - next döngüsü ile tüm gruplar için vcard oluşturma işlemi tanımlanmış durumdadır (sadece checkbox tikini açmanız yeterlidir seçeneklerden grup seçmeye gerek yoktur) , ayrıca kodunuzda recordsette kayıt yoksa hata verir buna ilişkin denetim de yoktu, onu da ekledim; hangi grupta kayıt oluşturulamadı uyarı verir.
Sizin konularınıza şahsen verdiğim son cevaptır, sadece ilgilenen başka insanlar fayda sağlasınlar diye kodu düzenledim. Sizin amacınız öğrenmek falan değil işinizi gördürmek; bu sebeple bir daha herhangi bir sorunuza şahsen ben cevap vermeyeceğim, bilginiz olsun.
Konuyu Okuyanlar: 1 Ziyaretçi
