اذهب الي المحتوي
Khalf

إضافة ظل إلى نص برمجياً كود / أمر VBA

Recommended Posts

السلام عليكم

أحتاج إلى أمر / كود فيجوال يمكنني من إضافة ظل إلى نص .

خلال عملي لـ template في الوورد احتجت إلى هذا الأول و قد  بحثت و لم أجد إجابة واضحة 

فلم أحصل على الطريقة الملائمة للاستفادة من الخاصية  

.FONT.shadow 

بانتظار إسهاماتكم بارك الله بكم .

شارك هذه المشاركه


رابط المشاركه
شارك

المشكلة في تطبيق الأمر المذكور آنفاً أني لا أستطيع التحكم بالظل و خصائصه 

السؤال الثاني المرتبط 

كيف أستطيع تطبيق نوع من الظلال الموجودة ضمن تبويب التأثيرات ؟

شارك هذه المشاركه


رابط المشاركه
شارك
Sub AddFontShadow()
    Dim shad As Word.ShadowFormat

    Set shad = Selection.Font.TextShadow
    With shad
        Debug.Print "Blur: " & .Blur, _
                    "ForeColor: " & .ForeColor, _
                    "Obscured: " & .Obscured, _
                    "OffsetX: " & .OffsetX, _
                    "OffsetY: " & .OffsetY, _
                    "Style: " & .style, _
                    "Transparency: " & .Transparency, _
                    "Type: " & .Type
    End With
End Sub

كل الشكر لمن قدم الكود

من موقع 

Stackoverflow

شارك هذه المشاركه


رابط المشاركه
شارك

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان

  • محتوي مشابه

    • بواسطه ياسر فاروق
      الساده
      السلام عليكم ورحمة الله وبركاته
      المرفق كود عمليه ضرب عمودين ووضع الناتج فى العمود الثالث من احد الساده الافاضل بالموقع
      وأريد شرح لخطوات الكود حتى أستطيع الاستفاده منه فى ملف أخر ولكن مسمى الأعمدة مختلفة
      Sub BOQ()
         
          For s = 1 To Sheets.Count
              Sheets(s).Select
              x = Cells.SpecialCells(xlCellTypeLastCell).Row
              For r = 8 To x
                  If IsNumeric(Cells(r, "I")) = False Then Cells(r, "F").FormulaR1C1 = "=RC[2]*RC[4]"
              Next r
          Next s
      End Sub
       
      وشكرا
    • بواسطه AYMAN Z HARB
      السلام عليكم 
      هل يوجد حل لهذه المشكلة 
      مع العلم انها تظهر في ويندوز 10  وفي الاصدارات الاخرى لاتظهر 
      المشكلة في ملف عمل اكسيل 2003  و اكسيل 2010  نفس المشكلة 
      يرجى الافادة وشكرا 

    • بواسطه king5star
      السلام عليكم اخوانى
      ما اريدة هو تعديل لكود تصدير اسماء الزوار الى ملف VCF لسهولة استدعاءة للهاتف المحمول.الكود يعمل بنجاح ولكن لاول اسم فقط ولا يقوم بتصدير باقى الاسماء الكود :
      Const ForReading = 1, ForWriting = 2, ForAppending = 3 Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 Dim rst As DAO.Recordset Dim fs, f, ts, s 'انشاء الملف فى المسار المحدد بالسطر التالى     ActiveControl.Hyperlink.CreateNewDocument "E:\LotusNotes_VCard.vcf", True, True ' فتح الملف المصدر     Set fs = CreateObject("Scripting.FileSystemObject")     Set f = fs.GetFile("E:\LotusNotes_VCard.vcf")          Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault) ' استدعاء البيانات من الجدول Set rst = CurrentDb.OpenRecordset("Invetion") rst.MoveFirst Do Until rst.EOF     ts.writeLine "begin:vcard"     ts.writeLine "fn:" & rst![Inv_Name]     ts.writeLine "tel;cell;voice:" & rst![Inv_Mobile]     ts.writeLine "ts.write version:2.1"     ts.writeLine "End: vcard"     rst.MoveNext Loop ' اغلاق الجدول rst.Close ' اغلاف الملف     ts.Close VCard.zip
    • بواسطه محمد الخالد
      السلام عليكم ورحمة الله وبركاته 
      الرجاء المساعدة في حل
      مشكلة اولى تظهر عند تشغيل كود لتكرار اوراق وتعبئتها حسب الداتا الموجودة في ورقة ثانية .
      مشكلة تانية ظهور اصفار (0) عند عدم وجود احد البيانات والمفروض عدم ظهور شيء في الخلية 
      وشكرا مقدماً 
       
      ‏‏ورقة اسماء اولية.xlsm
    • بواسطه mahamad ramadan
      ياجماعة كان فيه أخ فاضل منزل برنامج كشوف الملاحظة وهو برنامج رائع بس أنا مش عارف أعدل في الكود عشان العدد في مدرستي كبير أكتر من 20 لجنة وهو متصمم على 16 لجنة بس
      فرجاء شرح الكود وكيفية التعديل عليه
      أولا ده الكود ملئ بيانات اليوم الأول:
      Sub يوم1فترة1()
      Application.ScreenUpdating = False
      Sheets("الكشاف").Range("a10:f" & ['الكشاف'!d3] + 9).Select
           Selection.Sort Key1:=Range("f10"), Order1:=xlAscending
           Sheets("الكشاف").Range("n10:p" & ['الكشاف'!d3] + 9).ClearContents
      r = 10
      x = 10
      xx = ['الكشاف'!d3] + 9
      For i = x To xx
      If Sheets("الكشاف").Cells(i, 3) <> ['الكشاف'!p5].Value And Sheets("الكشاف").Cells(i, 3) <> ['الكشاف'!p6].Value And Sheets("الكشاف").Cells(i, 7) <> "-" And Sheets("الكشاف").Cells(i, 7) <> "" And Sheets("الكشاف").Cells(i, 4) <> "" Then
             ' Sheets("الكشاف").Cells(r, 14).Value = r - 59
            Sheets("الكشاف").Cells(r, 14) = Sheets("الكشاف").Cells(i, 4)
          r = r + 1
              End If
      Next i
      Sheets("الكشاف").Range("a10:f" & ['الكشاف'!d3] + 9).Select
           Selection.Sort Key1:=Range("a10"), Order1:=xlAscending
      Application.ScreenUpdating = True
      Range("n10").Select
      End Sub
      ثانيا
      ده الكود بتاع ملئ كشف الملاحظة
       
      Sub ملء1()
      Application.ScreenUpdating = False
      Sheets("كشوف الملاحظة").Range("f7:h40").ClearContents
      ff = Application.InputBox(prompt:="أدخل الرقم ", Title:="رقم العمود", Type:=1)
      r = 7
      x = 10
      xx = 40
      For i = x To xx
           Sheets("كشوف الملاحظة").Cells(r, 6) = Sheets("الكشاف").Cells(i, ff)
          Sheets("كشوف الملاحظة").Cells(3, 6) = Sheets("الكشاف").Cells(9, ff)
          Sheets("كشوف الملاحظة").Cells(3, 9) = Sheets("الكشاف").Cells(8, ff + 2)
           Sheets("كشوف الملاحظة").Cells(4, 9) = Sheets("الكشاف").Cells(9, ff + 2)
          r = r + 1
             
      Next i
      Application.ScreenUpdating = True
      End Sub
      فبرجاء شرح طريقة التعديل حتى يستوعب عدد أكبر من اللجان
      كشوف الملاحظة.xls
  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×