VBA PowerPoint: Các hàm hay sưu tầm VBA PowerPoint: Các hàm hay sưu tầm
910 10

Bài viết VBA PowerPoint: Các hàm hay sưu tầm

VBA PowerPoint: Các hàm hay sưu tầm

Thứ Ba, 5 tháng 1, 2016

kiểm tra tất cả fonts thiếu trong một slide

Option Base 1
Sub MissingFonts()
Dim sfont As Long
Dim PresFonts() As String, MissingFonts() As String
Dim NumFontsInPres As Integer
Dim FontInstalled As Boolean, FontMissing As Boolean
NumFontsInPres = ActivePresentation.Fonts.Count
ReDim PresFonts(CInt(NumFontsInPres))
  For i = 1 To NumFontsInPres
    PresFonts(i) = ActivePresentation.Fonts(i).Name
  Next i
  Set wordapp = CreateObject("Word.document")
  With wordapp
    .Application.Visible = False
    .Parent.System.cursor = wdCursorWait
    For i = 1 To NumFontsInPres
      For Each FontName In wordapp.Application.FontNames
        If FontName = PresFonts(i) Then
          FontInstalled = True
        End If
      Next FontName
      If FontInstalled = False Then
        On Error GoTo FirstFoundMissingFont
        MissFontSize = UBound(MissingFonts())
        GoTo NoError
FirstFoundMissingFont:
        MissFontSize = 0
NoError:
        ReDim Preserve MissingFonts(CInt(MissFontSize + 1))
        MissingFonts(CInt(MissFontSize + 1)) = PresFonts(i)
      End If
    Next i
    .Parent.System.cursor = wdCursorNormal
    .Application.Quit
  End With
  Set wordapp = Nothing
  On Error GoTo EmptyArray
  If LBound(MissingFonts) = UBound(MissingFonts) Then GoTo FullArray
EmptyArray:
  MsgBox "All fonts are installed"
  Exit Sub
FullArray:
  For j = 1 To UBound(MissingFonts)
    FontList$ = MissingFonts(j) + vbCr
  Next j
  MsgBox "The following fonts are missing:" + vbCr + FontList$
End Sub
Sub TextFonts()

Replace all fonts with destination font

Đổi tất cả các fonts VNI trong slide thành fonts VNI khác có sẵn trên máy tính của bạn
The code below will change the text in most or all of the PowerPoint shapes in your presentation (though it won't affect text in charts, inserted objects and some other PPT bits and pieces).

Sub ReplaceFont()

    Dim oSl As Slide
    Dim oSh As Shape
    Dim sFontName As String

    ' Chang to the VNI font you have on your Computer, or search online for any VNI fonts:
    sFontName = "VNI-Helve-Condense"

    With ActivePresentation
        For Each oSl In .Slides
            For Each oSh In oSl.Shapes
                With oSh
                    If .HasTextFrame Then
                        'If font start with VNI then replace with the VNI font you have on your computer (sFontName)
                        If .TextFrame.HasText And InStr(1, .TextFrame.TextRange.Font.Name, "VNI") = 1 Then
                            'Debug.Print (.TextFrame.TextRange.Font.Name)
                            .TextFrame.TextRange.Font.Name = sFontName
                        End If
                    End If
                End With
            Next
        Next
    End With

End Sub



Từ khóa: VBA PowerPoint: Các hàm hay sưu tầm
Bình Luận