Consulting

Results 1 to 3 of 3

Thread: PPTX - Replace fonts in multiple files

  1. #1
    VBAX Newbie
    Joined
    Mar 2019
    Posts
    2
    Location

    PPTX - Replace fonts in multiple files

    Cheers everyone,
    I have around 3000 pptx files organized in folders/subfolders and I have to replace the fonts in all of them.
    I'm working on a VBA macro that would allow the user to:
    - pick a folder
    - iterate through all the pptx files in that folder (and in its subfolders!)
    - replace the font "x" with the font "y"
    - replace the font "z" with the font "w"
    Edit:
    - set font "w" as 'bold'

    Could anyone be so kind to help me with my problem? I know absolutely nothing about VBA

    Thank you in advance!
    Last edited by Bigabyte; 03-04-2019 at 02:29 AM.

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    You are asking someone to do an awful lot of free work to achieve that. Realistically you need to hire an expert to create an Add In.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    Mar 2019
    Posts
    2
    Location
    Quote Originally Posted by John Wilson View Post
    You are asking someone to do an awful lot of free work to achieve that. Realistically you need to hire an expert to create an Add In.
    Thank you John for your reply. I assumed It was a fairly simple job, I'm obviously not expecting anyone to do anything too time-consuming for free...I wouldn't have even asked otherwise!

    I've came across the vba function that'sused to replace fonts, but It's not always working as expected. This is the code I found:

    Application.ActivePresentation.Fonts _    .Replace Original:="Times New Roman", Replacement:="Courier"
    
    I've also found a few lines of code that should allow to run a macro on multiple workbooks at the same time, which are:
    SubLoopThroughFiles()    Dim xFd As FileDialog
        Dim xFdItem As Variant
        Dim xFileName As String
        Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
        If xFd.Show = -1 Then
            xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
            xFileName = Dir(xFdItem & "*.xls*")
            Do While xFileName <> ""
                With Workbooks.Open(xFdItem & xFileName)
                    'your code here
                End With
                xFileName = Dir
            Loop
        End If
    EndSub
    This is the link to the full guide: https://www.extendoffice.com/documen...workbooks.html

    I've tried to take the latter code as a reference and tweak it a bit to accomodate my needs, but to no avail.

    I'll be extremely grateful to anyone pointing me in the right direction.

    Thank you and have a good day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •