Tự động tô màu keyword VBA trên PowerPoint

tuhocvba

Administrator
Thành viên BQT
Trong quá trình xây dựng bài giảng VBA, tôi muốn tô màu các keyword VBA có trong Slide.
Input:
Bạn cần đăng nhập để thấy đính kèm

Output:
Bạn cần đăng nhập để thấy đính kèm

Mã:
'Author: admin tuhocvba
'Website: tuhocvba.net
'Date: 24/9/2022
Sub tomaukeyword()
    Dim txt As String
    Dim n   As Long, i As Long, j As Long, k As Long
    Dim key As String, duoi As String, s As String
    Dim shp As Shape
    Dim brr As Variant, keyrr   As Variant
    
    brr = Array(".", " ", "(", Chr(10), Chr(13))
    
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    Call napmang(keyrr)
    
    For Each shp In ActivePresentation.Slides(n).Shapes
        txt = shp.TextFrame.TextRange.Text
        For j = LBound(keyrr) To UBound(keyrr) Step 1
            key = keyrr(j)
            For i = LBound(brr) To UBound(brr) Step 1
                duoi = CStr(brr(i))
                s = key & duoi
                k = 0
                Do
                    k = InStr(k + 1, txt, s, vbBinaryCompare)
                    If k > 0 Then
                        shp.TextFrame.TextRange.Characters(k, Len(key)).Font.Color.RGB = RGB(0, 0, 255)
                        'k la ky tu bat dau
                        'Len(key) : so thu tu muon to mau
                    Else
                        k = InStr(k + 1, txt, key, vbBinaryCompare)
                        If k + Len(key) - 1 = Len(txt) Then
                            shp.TextFrame.TextRange.Characters(k, Len(key)).Font.Color.RGB = RGB(0, 0, 255)
                            k = 0
                        Else
                            k = 0
                        End If
                    End If
                Loop Until k = 0
            Next i
        Next j
    Next shp
'    For Each shp In ActivePresentation.SlideMaster.Shapes
End Sub
Sub napmang(ByRef keyrr As Variant)
    keyrr = Array("Sub", "End Sub", "Dim", "As", "Private", "Public", _
                    "Function", "End Function", "Long", "Integer", "String", "Variant", "For Each", _
                    "For", "In", "LBound", "UBound", "Step", "If", "Then", "End If", "Else", "ElseIf", _
                    "Do While", "Do", "Loop Until", "Loop", "Next", "Goto", "CStr", "To")
End Sub
 
Top