البحث في الموقع

ملاحظاتي: - أتعبني تحويل رقم اللون الطويل إلى هيكس Hex أرقام سداسية إن صح التعبير واضطررت لعمل دالة لمعالجة مخرجات الدالة الأصل. - لم أصل إلى نوع مقاس الخط لأتمكن من حويلة بشكل دقيق فاضطررت لاستخدام رقم تقريبي بتقسيمه على 3.5 . - استخدمت كل خصائص الخط في صندوق كلمة/نص البحث ما عدا اسم الخط. - حاليا تبديل خصائص الخط في صندوق البحث يدويا (في طور التصميم) ويمكنكم إضافة تعديله بواسط الأزرار والخيارات في طور التشغيل. - مسموح للجميع التطوير فيه مباشرة وبدون إذن. - الدالة مصممة ليستفاد منها في الاستعلامات وفي الجداول لحقول المذكرة. Option Compare Database Option Explicit Function myHex(Color As Long) As String Dim hexStr As String hexStr = Hex(Color) If Len(hexStr) = 6 Then hexStr = Right(hexStr, 2) & Mid(hexStr, 3, 2) & Left(hexStr, 2) Else hexStr = Left(Right(hexStr, 2) & Left(hexStr, Len(hexStr) - 2) & "000000", 6) End If myHex = "#" & hexStr End Function Function RichText(ByVal sText As Variant, frmCtl As String) As String Dim sWord As String Dim lStr As String Dim rStr As String Dim sPos As Integer Dim fSize As Double sPos = InStr(1, frmCtl, ",") With Forms(Left(frmCtl, sPos - 1)).Controls(Right(frmCtl, sPos + 1)) sText = PlainText(Nz(sText, "")) sWord = PlainText(Nz(.Value, "")) rStr = "</font>" lStr = "<font color=""" & myHex(.ForeColor) & """>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) 'sText = Replace(Replace(sText, rStr & " " & lStr, " ", 1), rStr & "" & lStr, "", 1) lStr = "<font style='BACKGROUND-COLOR:" & myHex(.BackColor) & "'>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) fSize = .FontSize / 3.5 'تحويل تقريبي lStr = "<font size=" & fSize & "pt>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) If .FontBold Then lStr = "<b>": rStr = "</b>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) End If If .FontItalic Then lStr = "<i>": rStr = "</i>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) End If If .FontUnderline Then lStr = "<u>": rStr = "</u>" sText = Replace(sText, sWord, lStr & sWord & rStr, 1) End If End With RichText = sText End Function RichTextHighlight_01.accdb