اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search
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

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


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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • محتوي مشابه

    • بواسطه كريمو2
      السلام عليكم احبتي مشرفي واعضاء المنتدى
      المطلوب التعدبل على الكود لكي يظهر الميساج مرة واحدة خلال كل شهر وبشرط وجود مبلغ إقتطاع
      واذا لم يكن وجود مبلغ الإقتطاع يظهر الميساح بعدم وجود الإقتطاع خلال هذا الشهر ويكون كذلك مرة واحدة كل شهر

       
      Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.TxtMonth & "')") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount a1 = 0 'just a flag a2 = 0 'jusf a flag If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then Select Case MsgBox(" هل تريد ان يتم توزيع الإقتطاعات لشهر" & Me.TxtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To RC rst.Edit 'check, maybe a manual payment is done, so don't over write it 'If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then rst!Payment_Made_Cridi = rst!Loan_Cridi rst!sadad = rst!Loan_Cridi If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made_Cridi, 0) + Nz(rst!Payment_Made_Elec, 0) + Nz(rst!Loan_Other, 0) 'a1 = 1 'End If 'If Len(rst!Payment_Made_Elec & "") = 0 And Not IsNull(rst!Loan_Elec) Then 'rst!Payment_Made_Elec = rst!Loan_Elec 'a1 = 1 'End If rst.Update rst.MoveNext Next i TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) Case vbNo MsgBox "لم يتم توزيع الإقتطاعات " End Select 'GoTo I_am_Done 'Other loans for, March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "[detach]='موظف'" 'myCriteria = myCriteria & " Or [detach]='منتدب'" myCriteria = myCriteria & " Or [detach]='متعاقد كامل'" myCriteria = myCriteria & " Or [detach]='متعاقد جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافة'" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst RC = rstE.RecordCount For i = 1 To RC 'check if payment is already entered, if it is, then skip this Record rst.FindFirst "[Loan_Type]='Other' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.TxtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 'rst!Loan_AwardMonth = Me.AwardMonth rst!Payment_Month = DateSerial(Year(Me.TxtMonth), Month(Me.TxtMonth), 1) 'rst!Loan_Cridi = Me.txtDiscountPerMonth 'rst!Loan_Elec= 'to be used in Elec loan Form rst!Loan_Other = 1100 'to be used in Other loan Form 'rst!Payment_Made = 'to be used each time a pyment is made rst!Loan_Type = "Other" rst!Remarks = "إقتطاع من الراتب لإشتراك شهر " & Year(Me.TxtMonth) & "/" & Month(Me.TxtMonth) rst.Update End If rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If I_am_Done: 'clean up rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then 'No Records, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub  
    • بواسطه ياسر فاروق
      الساده
      السلام عليكم ورحمة الله وبركاته
      المرفق كود عمليه ضرب عمودين ووضع الناتج فى العمود الثالث من احد الساده الافاضل بالموقع
      وأريد شرح لخطوات الكود حتى أستطيع الاستفاده منه فى ملف أخر ولكن مسمى الأعمدة مختلفة
      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
  • المتواجدين الان   0 اعضاء متواجدين الان

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

×
×
  • اضف...