Forum İpucu EXCELDEN TOPLU TELEFON NUMARASINI KAYIT ETME

Katılım
9 Ocak 2019
Mesajlar
33
Excel Vers. ve Dili
2010 türkçe
ARKADAŞLAR TAM ANLAMLI BİR BAŞLIK OLMADI KUSURA BAKMAYIN AMA SORUNUM ŞU Kİ;
600 KİŞİLİK BİR EXCEL REHBERİM VAR BUNU TELEFONA EKLEMEM LAZIM NASIL YAPABİLİRİM ACABA...
 

Ekli dosyalar

Mahmut Bayram

Özel Üye
Katılım
25 Haziran 2005
Mesajlar
1,778
Excel Vers. ve Dili
2016 Excel Tr
Hiç denemedim lakin farklı kaydet yaparken formatı csv yaparak kaydedip denediniz mi?
Telefon belleğine atıp oradan da yüklemeyi ...
 
Son düzenleme:

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
Ben vbada tasarladım onu vba biliyorsanız kodlarla hazırlamanız 10 dknızı almaz
 
Katılım
9 Ocak 2019
Mesajlar
33
Excel Vers. ve Dili
2010 türkçe
BİLGİM YOK BANA VEREMEZ MİSİN ÇOK ACİL YAPMAM LAZIM KARDEŞİM İŞİM BUNA BAĞLI DA...
 

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
ATABİLCEM BİŞİ DEĞİL AMA LİSTENİZİ ATARSANIZ CEVİREBİLİRİM PROGRAMIN EXESİNİ OLUŞTURMADIM CUNKU COK ONCEDEN LAZIM OLMUSTU OYLE PROJE OLARAK DURUYOR
 
Katılım
9 Ocak 2019
Mesajlar
33
Excel Vers. ve Dili
2010 türkçe
WİNRAR YAPIP ATARSINIZ ASLINDA NASIL BİRŞEY Kİ TAM OLARAK ÇOK ÖNEMLİ BENİM İÇİN VEREMEZ MİSİNİZ PROGRAMI
 

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
MALESEF PROGRAM DEĞİL EĞER BİLGİSAYARINIZDA VİSUAL BASİC 2019 LİSANSLI SURUM VARSA ATAYIM SİZDE CALISIR YOKSA YAPABİLCEM BİŞİ YOK MALESEF
 

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
Dediğim gibi yapabilcem bir şey yok malesef hani sizin için bu kadar önemli ise bu işi yapan siteler var onlardan yardım alabilirsiniz ben elimden gelen yardımı sundum size
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
Forumda arama yaparsanız benzer birçok konuya ulaşabileceğinizi düşüyorum.
Örnek
 

evrensngr

Altın Üye
Katılım
7 Mayıs 2019
Mesajlar
40
Excel Vers. ve Dili
Microsoft 2017
Visual Studio 2013-2014-2017-2019
Sub Test4()

Dim objShell As Object, objStream As Object
Dim strDesktop As String, i As Long, NoA As Long
Dim Name As Variant, myStr As String, lastName As String, firstName As String
Const adSaveCreateOverWrite = 2

Set objShell = CreateObject("Wscript.Shell")
strDesktop = objShell.SpecialFolders("Desktop")

NoA = Range("A" & Rows.Count).End(xlUp).Row

Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "windows-1254"
objStream.Open

For i = 2 To NoA
Name = Split(Trim(Range("A" & i).Text), " ")
lastName = Name(UBound(Name))
firstName = Trim(Replace(Range("A" & i).Text, lastName, ""))
myStr = "BEGIN:VCARD" & vbCrLf
myStr = myStr & "VERSION:3.0" & vbCrLf
myStr = myStr & "N;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & lastName & ";" & firstName & ";;;" & vbCrLf
myStr = myStr & "FN;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & Range("A" & i) & vbCrLf
myStr = myStr & "TEL;type=CELL;type=VOICE;type=pref:" & Range("B" & i) & vbCrLf
myStr = myStr & "TEL;type=HOME;type=VOICE:" & Range("C" & i) & vbCrLf
myStr = myStr & "EMAIL;TYPE=HOME,TYPE=pref;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
myStr = myStr & "END:VCARD" & vbCrLf
objStream.WriteText myStr
Name = ""
Next

objStream.SaveToFile strDesktop & "\myVcard.vcf", adSaveCreateOverWrite
objStream.Close

Set objStream = Nothing
Set objShell = Nothing
End Sub
Yada bu kodları kullanın tercih sizin excelde çalışma sayfanıza buton ekleyip
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
Sub Test4()

'Haluk - 23/01/2019
'E-POsta: sa4truss@gmail.com
'
Dim objShell As Object, objStream As Object
Dim strDesktop As String, i As Long, NoA As Long
Dim Name As Variant, myStr As String, lastName As String, firstName As String
Const adSaveCreateOverWrite = 2

Set objShell = CreateObject("Wscript.Shell")
strDesktop = objShell.SpecialFolders("Desktop")

NoA = Range("A" & Rows.Count).End(xlUp).Row

Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "windows-1254"
objStream.Open

For i = 2 To NoA
Name = Split(Trim(Range("A" & i).Text), " ")
lastName = Name(UBound(Name))
firstName = Trim(Replace(Range("A" & i).Text, lastName, ""))
myStr = "BEGIN:VCARD" & vbCrLf
myStr = myStr & "VERSION:3.0" & vbCrLf
myStr = myStr & "N;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & lastName & ";" & firstName & ";;;" & vbCrLf
myStr = myStr & "FN;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & Range("A" & i) & vbCrLf
myStr = myStr & "TEL;type=CELL;type=VOICE;type=pref:" & Range("B" & i) & vbCrLf
myStr = myStr & "TEL;type=HOME;type=VOICE:" & Range("C" & i) & vbCrLf
myStr = myStr & "EMAIL;TYPE=HOME,TYPE=pref;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
myStr = myStr & "END:VCARD" & vbCrLf
objStream.WriteText myStr
Name = ""
Next

objStream.SaveToFile strDesktop & "\myVcard.vcf", adSaveCreateOverWrite
objStream.Close

Set objStream = Nothing
Set objShell = Nothing
End Sub
Yada bu kodları kullanın tercih sizin excelde çalışma sayfanıza buton ekleyip
Güzel kod, yazanın ellerine sağlık...
 

aligunes

Altın Üye
Katılım
2 Mart 2005
Mesajlar
303
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
İlgili yerlere listeni yapıştır vcard oluştur butona tıkla rehberin masaüstünde hazır
 

Ekli dosyalar

Üst