يستخدم think-cell لون خط غير صحيح

تكرار الخطأ دون استخدام think-cell

تقوم وحدة الماكرو التالية بإدراج شريحة جديدة مع مربع نص يعرض قيم لون الخط الناتجة لكل TextStyleLevel للشريحة الرئيسية في PowerPoint. "يعرض TextStyleLevel [1]" لون الخط الرئيسي الذي يوفره PowerPoint.

1. افتح ملف PowerPoint المتأثر بالمشكلة وافتح محرر VBA بواسطة الضغط على المفتاحين Alt+F11
2. في محرر VBA، حدد العرض التقديمي ثم انقر فوق إدراج ← وحدة نمطية جديدة
3. الصق وحدة الماكرو التالية وأغلق محرر VBA
4. في نافذة العرض التقديمي في PowerPoint، اضغط على المفتاحين Alt+F8 لفتح النافذة وحدات ماكرو
5. حدد عرض وانقر فوق تشغيل

Function AppendToTextRange(txtfrm2 As PowerPoint.TextFrame2) As Office.TextRange2
    Set AppendToTextRange = _
	txtfrm2.TextRange.Characters(txtfrm2.TextRange.Length + 1, 0)
End Function

Sub Demonstrate()
    Dim pres As PowerPoint.Presentation
    Set pres = ActivePresentation
    
    Dim sld As PowerPoint.Slide
    Set sld = pres.Slides.Add(pres.Slides.Count + 1, PowerPoint.ppLayoutBlank)
    sld.Select
    
    Dim mstr As PowerPoint.Master
    Set mstr = sld.Design.SlideMaster
    
    Dim shp As PowerPoint.Shape
    Set shp = sld.Shapes.AddShape(Office.msoShapeRectangle, 50, 50, _
    pres.PageSetup.SlideWidth / 2 - 50, pres.PageSetup.SlideHeight - 100)
    shp.Fill.ForeColor.RGB = RGB(255, 255, 122) 'light yellow backgound

    Dim txtfrm2 As PowerPoint.TextFrame2
    Set txtfrm2 = shp.TextFrame2
    
    Dim txtrng2 As Office.TextRange2
    Dim i As Integer
    i = 1
    Dim txtlvl As PowerPoint.TextStyleLevel
    For Each txtlvl In mstr.TextStyles(PowerPoint.ppBodyStyle).Levels
        Set txtrng2 = AppendToTextRange(txtfrm2)
        txtrng2.Text = "TextStyleLevel[" & i & "] has color " & vbCr
        txtrng2.Font.Fill.Solid
        txtrng2.Font.Fill.ForeColor.ObjectThemeColor = Office.msoThemeColorText1
        
        Set txtrng2 = AppendToTextRange(txtfrm2)
        Dim col As PowerPoint.ColorFormat
        
        Set col = txtlvl.Font.Color
        If PowerPoint.ppSchemeColorMixed = col.Type Then
            txtrng2.Text = "MIXED (should not occur)" & vbCr & vbCr
        Else
            If Office.msoNotThemeColor = col.ObjectThemeColor Then
                Dim nRgb As Long
                nRgb = col.RGB()
                txtrng2.Text = "RGB: " & (nRgb Mod 256) & "/" & ((nRgb \ 256) _
                Mod 256) & "/" & (nRgb \ 256 \ 256) & vbCr & vbCr
                txtrng2.Font.Fill.ForeColor.RGB = nRgb
            Else
                txtrng2.Text = "ObjectThemeColor: " & col.ObjectThemeColor _
                & vbCr & vbCr
                txtrng2.Font.Fill.ForeColor.ObjectThemeColor = col.ObjectThemeColor
            End If
        End If
        i = i + 1
    Next txtlvl
End Sub