اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر
في 2/13/2018 at 09:09, محمد طاهر said:

من ناحية اخري جرب التالي:

اولا عند توقف الكود قف بالماوس عند كل متغير فى السطر الاصفر ، و اكتب القيمة التي تظهر لك هنا

لم تفدنا بالرد

 

  • Confused 1
قام بنشر
47 minutes ago, محمد طاهر said:

لم تفدنا بالرد

 

استاذنا الغالي المعذرة منك

جربت كود اخر  و اشتغل معي كما هو مبين ادناه

و لكن المشكلة في ظهور الاسماء على شكل رموز؟

هل يوجد تعديل في سطر معين في الكود لتلافي هذه المشكلة؟

Sub excelTovcf()
    Dim FileNum As Integer
    Dim iRow As Integer
    Dim FirstName As String
    Dim LastName As String
    Dim FullName As String
    Dim EmailAddress As String
    Dim PhoneHome As String
    Dim PhoneWork As String
    Dim Organization As String
    Dim JobTitle As String
    
    iRow = 7
    ' set a unique integer for the new
    ' text file
    FileNum = FreeFile
    ' Save this vcf file on desktop
    OutFilePath = VBA.Environ$("UserProfile") & "\Desktop\MyContacts.VCF"
    Open OutFilePath For Output As FileNum

    With Sheets("contacts")
    While VBA.Trim(.Cells(iRow, 1)) <> ""
        FirstName = VBA.Trim(.Cells(iRow, 1))
        LastName = VBA.Trim(.Cells(iRow, 2))
        FullName = VBA.Trim(.Cells(iRow, 3))
        EmailAddress = VBA.Trim(.Cells(iRow, 4))
        PhoneHome = VBA.Trim(.Cells(iRow, 5))
        PhoneWork = VBA.Trim(.Cells(iRow, 6))
        Organization = VBA.Trim(.Cells(iRow, 7))
        JobTitle = VBA.Trim(.Cells(iRow, 8))
    ' Start printing the data in above specified
    ' format of VCF file format
        Print #FileNum, "BEGIN:VCARD"
        Print #FileNum, "VERSION:3.0"
        Print #FileNum, "N:" & FirstName & ";" & LastName & ";;;"
        Print #FileNum, "FN:" & FullName
        Print #FileNum, "ORG:" & Organization
        Print #FileNum, "TITLE:" & JobTitle
        Print #FileNum, "TEL;TYPE=HOME,VOICE:" & PhoneHome
        Print #FileNum, "TEL;TYPE=WORK,VOICE:" & PhoneWork
        Print #FileNum, "EMAIL:" & EmailAddress
        Print #FileNum, "END:VCARD"
        iRow = iRow + 1
    Wend
 End With
    'Close The File
    MsgBox "Total " & iRow - 7 & " Contacts are exported to VCF File. It is saved on your Desktop"
    Close #FileNum
End Sub

 

 

 

قام بنشر

جرب تعديل الحقول التي تحوي اسماء الي ترميز اللعة العربية عند التصدير

        Print #FileNum, "N;LANGUAGE=en-us;CHARSET=windows-1256:" & FirstName & ";" & LastName & ";;;"
        Print #FileNum, "FN;CHARSET=windows-1256:" & FullName

 

  • Like 1
قام بنشر (معدل)
6 ساعات مضت, محمد طاهر said:

جرب تعديل الحقول التي تحوي اسماء الي ترميز اللعة العربية عند التصدير


        Print #FileNum, "N;LANGUAGE=en-us;CHARSET=windows-1256:" & FirstName & ";" & LastName & ";;;"
        Print #FileNum, "FN;CHARSET=windows-1256:" & FullName

 

هل الكود النهائي سيصبح بهذا الشكل .؟

Sub excelTovcf()
    Dim FileNum As Integer
    Dim iRow As Integer
    Dim FirstName As String
    Dim LastName As String
    Dim FullName As String
    Dim EmailAddress As String
    Dim PhoneHome As String
    Dim PhoneWork As String
    Dim Organization As String
    Dim JobTitle As String
    
    iRow = 7
    ' set a unique integer for the new
    ' text file
    FileNum = FreeFile
    ' Save this vcf file on desktop
    OutFilePath = VBA.Environ$("UserProfile") & "\Desktop\MyContacts.VCF"
    Open OutFilePath For Output As FileNum

    With Sheets("contacts")
    While VBA.Trim(.Cells(iRow, 1)) <> ""
        FirstName = VBA.Trim(.Cells(iRow, 1))
        LastName = VBA.Trim(.Cells(iRow, 2))
        FullName = VBA.Trim(.Cells(iRow, 3))
        EmailAddress = VBA.Trim(.Cells(iRow, 4))
        PhoneHome = VBA.Trim(.Cells(iRow, 5))
        PhoneWork = VBA.Trim(.Cells(iRow, 6))
        Organization = VBA.Trim(.Cells(iRow, 7))
        JobTitle = VBA.Trim(.Cells(iRow, 8))
    ' Start printing the data in above specified
    ' format of VCF file format
        Print #FileNum, "BEGIN:VCARD"
        Print #FileNum, "VERSION:3.0"
        Print #FileNum, "N;LANGUAGE=en-us;CHARSET=windows-1256:" & FirstName & ";" & LastName & ";;;"
        Print #FileNum, "FN;CHARSET=windows-1256:" & FullName
        Print #FileNum, "ORG:" & Organization
        Print #FileNum, "TITLE:" & JobTitle
        Print #FileNum, "TEL;TYPE=HOME,VOICE:" & PhoneHome
        Print #FileNum, "TEL;TYPE=WORK,VOICE:" & PhoneWork
        Print #FileNum, "EMAIL:" & EmailAddress
        Print #FileNum, "END:VCARD"
        iRow = iRow + 1
    Wend
 End With
    'Close The File
    MsgBox "Total " & iRow - 7 & " Contacts are exported to VCF File. It is saved on your Desktop"
    Close #FileNum
End Sub

 

اذا كان نعم ، فلا يوجد اي تغيير حيث تظهر الاسماء برموز و بجانبها الرقم ؟

تم تعديل بواسطه محمد طاهر
اضافة تنسيق الكود
قام بنشر

اختار اي شخص محفوظ فى الاوتلوك لديك

و قم بالاوتلوك بتصدير الكارت الخاص به و ارفقه  ، او افتحه باحدد محررات النصوص و ضع النص هنا

و ذلك لنحاول التعديل بما يناسب اعدادتك

 

ايضا لم ترد بشأن قيم المتغيرات  فى السطر الاصفر و التي ستظهر لك عند الوقوف بالماوس فوق المتغير دون الضغط عند توقف الكود و ظهور السطر الاصفر

 كما ارجو عدم استخدام الاقتباس لكامل المشاركة عند كل رد ، لان هذا تكرار لا داعي له ، و قد عدلت المشاركات السابقة ، و اذا اردت الاقتباس فليكن لجملة محددة تربد الرد عليها

 

  • Thanks 1
قام بنشر
14 hours ago, محمد طاهر said:

اختار اي شخص محفوظ فى الاوتلوك لديك

و قم بالاوتلوك بتصدير الكارت الخاص به و ارفقه  ، او افتحه باحدد محررات النصوص و ضع النص هنا

و ذلك لنحاول التعديل بما يناسب اعدادتك

مرفق الملف المطلوب

و لكن الكود ايضا يحتاج الى تعديل بحيث يصبح الاسم محفوظ فقط بدون الرقم بجانبه

الملف عبارة عن Vcard

قمت بتغيير الامتداد الى الى اكسل

MyContacts.xls

15 hours ago, محمد طاهر said:

ايضا لم ترد بشأن قيم المتغيرات  فى السطر الاصفر و التي ستظهر لك عند الوقوف بالماوس فوق المتغير دون الضغط عند توقف الكود و ظهور السطر الاصفر

 

لم يظهر لدي ما طلبت ، حيث و قد قمت مسبقا بالرد بإنه لا يوجد هذا الخيار لدي !!!

15 hours ago, محمد طاهر said:

 كما ارجو عدم استخدام الاقتباس لكامل المشاركة عند كل رد ، لان هذا تكرار لا داعي له ، و قد عدلت المشاركات السابقة ، و اذا اردت الاقتباس فليكن لجملة محددة تربد الرد عليها

المعذرة لن يتكرر هذا

قام بنشر

السلام عليكم 

انا ايضاْ ابحث منذ مده عن حل لهذه المشكلة و قد وجدت برنامج و لكنه مدفوع او مجاناً لا يقبل الا عشرة اسماء فضطررت الى تقسيم الاسماء التي عددها 1200 اسم الى 120 ملف اكسل في كل ملف عشرة اسماء و هذه العمليه مرهقه جداً.

بعد بحث طويل في النت و جدت طريقه لتحويل عدد لا محدود من الاسماء و لكن المشكله انه عند استيراد الملف vcf الى جهات الاتصال تظهر الاسماء العربيه على شكل علامات استفهام(؟؟؟؟؟؟؟) داخل مربعات سوداء صغيره .

أرجو من الأخوه الأكارم المساعدة في حل هذه المشكله.

سأضع في المرفقات الملف الذي حملته من النت و هو اكسل مع أوامر vb وقد اضفت الى الكود الترميز(charset=utf-8) لكن بقت المشكله كما هي.مع العلم ان المشكله ليست في هاتفي .

 

ExcelContactsToVCFConverter.xlsm

قام بنشر

السلام عليكم

بالنسبة للوقوف بالماوس فوق السطر المعلم بالاصفر عند قيمة المتغير و تحريك الماوس قليلا لتظهر قيمة المتغير كما يسمي بتلميحة Tool Tip ، فعلى حد علمي هذا بجب أن يظهر فى حال توقف الكود و ظهور السطر الأصفر ،و لا يمكنني تفسير لماذا لا يظهر معك.

بالنسبة للملف الذي ارفقته سابقا  لم اجد فيه ما يضاف الي ما اضفته فى آخر مثال لي و الذي عمل معي بكفاءة و جربه أحد الأخوة و أشار بنجاح تجربته 

حاليا ليس لدي جديد سوي المثال الذي اشرت اليه و لا ادري لماذا لم يعمل معكم ، و اذا وجدت جديد ساضيفه باذن الله

 

  • Thanks 1
  • 3 weeks later...
قام بنشر (معدل)

انا العكس مو يطلع العربي ملخبط الرقم يطلع ناقص يعني مثل كذا ٥٠٠٠٠٠٠٠ بدل من ٠٥٠٠٠٠٠٠ اللي يعرف حل يساعدني + لمى أسوي استيراد يطلع الرقم مكان الملاحظات😭

تم تعديل بواسطه Go__2016
  • 8 months later...
قام بنشر
في ١٨‏/٢‏/٢٠١٥ at 15:59, أشرف حسين said:

السلام عليكم ورحمة الله و بركانه

انا حاليا بواجه نفس المشكلة 

و عندي 4 ملفات ممكن تساعدني ؟

السلام عليكم ورحمة الله 

انا عند مشكلة عايز احول ملف الي Vcard لو امكن 

زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information