GophAcceView
05-04-2017, 02:37 PM
As a student, I get a lot of PowerPoints that are formatted in a non- "Print Friendly Manner".
Many PowerPoints contain :
Colorful Backgrounds (White Background = Saves Ink)
Background Designs (No Design = Saves Ink)
White (or Light Color) Text (Incompatible w/ White Background)
White (or Light Color) Table Borders (Incompatible w/ White Background)
Text Shadow Effects (Best w/ Light Color Text, Blurry w/ Black Text)
These colors / effects can exist in both what VBA recognizes as Table(s) or TextFrame(s)
Existing Solutions are Inadequate :
i.e. 1. Changing the Theme results in Changing Font Styles and moving objects around such that timely manual formatting is required.
2. Changing the Master Slide Background leaves text and Table borders requiring manual formatting (Timely Manual Process)
3. Changing the Print output to grey-scale or Black and White (Lose meanings and emphasis of Color objects, & print background design outlines)
I've compiled a VBA script that can prepare an entire PowerPoint for printing in "One Easy Click".
It does not change Font Style and therefore does not move objects around.
It removes background designs.
It changes background colors to White
It Changes Light Color Text to Black
It Changes Table borders to Black
It leaves most text colors as their original colors, so you have the meanings behind the colors, where needed.
It does not save changes automatically, so it can be tested and reverted if needed. Changes can be saved manually, per usual.
It's exactly what I was wanting (works perfectly for my needs, so I'm sharing).
Give it a try.
Let me know if any improvements are needed.
I'm a student, so I might not reply quickly, but others might help.
Below = Code, then Directions for use (below the Code)
Option Explicit
Sub PrintPreps()
' ###########################################
' View > Slide Master > BG Styles > Format BG > Solid Fill
' ###########################################
ActivePresentation.SlideMaster.Background.Fill.Solid
' ###########################################
' ###########################################
' View > Slide Master > BG Styles > Format BG > White BG
' ###########################################
ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB = RGB(255, 255, 255)
ActivePresentation.SlideMaster.Background.Fill.BackColor.RGB = RGB(255, 255, 255)
' ###########################################
' ###########################################
' Variable Prep Sets
' ###########################################
Dim oSld As Slide
Dim oShp As Shape
Dim oTbl As Table
Dim I As Long
Dim J As Long
Dim x As Long
Dim R As Long
Dim C As Long
' ###########################################
' ###########################################
' (Open Loop) For Ea. Slide One by One
' ###########################################
For Each oSld In ActivePresentation.Slides
' ###########################################
' ###########################################
' View > Slide Master > BG Styles > Format BG > Hide BG Graphics
' ###########################################
oSld.DisplayMasterShapes = msoFalse
' ###########################################
' ###########################################
' (Open Loop) For Ea. Shape One by One
' ###########################################
For Each oShp In oSld.Shapes
' ###########################################
' ###########################################
' Tables (Open)
' ###########################################
If oShp.HasTable Then
Set oTbl = oShp.Table
' ###########################################
' All Table Borders / Frames to Black (Open)
' ###########################################
For r = 1 To oTbl.Rows.Count
For c = 1 To oTbl.Columns.Count
With oTbl.Cell(r, c)
.Borders(ppBorderTop).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderBottom).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderLeft).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderRight).ForeColor.RGB = RGB(0, 0, 0)
End With
Next c
Next r
' ###########################################
' All Table Borders / Frames to Black (Closed)
' ###########################################
' ###########################################
' All Table "Light Color Text" to Black
' & remove Text Shadow (Open)
' ###########################################
For I = 1 To oTbl.Columns.Count
For J = 1 To oTbl.Rows.Count
With oTbl.Cell(J, I).Shape.TextFrame.TextRange.Font
.Shadow = msoFalse
oShp.Shadow.Visible = msoFalse
End With
With oTbl.Cell(J, I).Shape.TextFrame.TextRange
For x = .Runs.Count To 1 Step -1
If .Runs(x).Font.Color.RGB >= RGB(200, 200, 200) Then
.Runs(x).Font.Color.RGB = RGB(0, 0, 0)
End If
Next x
End With
Next J
Next I
' ###########################################
' All Table "Light Color Text" to Black
' & remove Text Shadow (Closed)
' ###########################################
End If ' HasTable
' ###########################################
' Tables (Closed)
' ###########################################
' ###########################################
' All TextFrames "Light Color Text" to Black
' & remove Text Shadow (Open)
' ###########################################
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Font.Shadow = msoFalse
oShp.Shadow.Visible = msoFalse
With oShp.TextFrame.TextRange
For x = .Runs.Count To 1 Step -1
If .Runs(x).Font.Color.RGB >= RGB(200, 200, 200) Then
.Runs(x).Font.Color.RGB = RGB(0, 0, 0)
End If
Next x
End With
End If ' HasText
End If ' HasTextFrame
' ###########################################
' All TextFrames "Light Color Text" to Black
' & remove Text Shadow (Closed)
' ###########################################
' ###########################################
' (Repeat / Close Loop) For Ea. Shape One by One
' ###########################################
Next oShp
' ###########################################
' ###########################################
' (Repeat / Close Loop) For Ea. Slide One by One
' ###########################################
Next oSld
' ###########################################
End Sub
Instructions : How to Use VBA Code :
' ###########################################
' Open the VBA Editor (Step #1)
' ###########################################
' Option 1 :
' Press "Alt + F11"
' Option 2 (In cases where "Alt + F11" fail, i.e. at a school computer) :
' > Customize Quick Access Toolbar (Upper Left Arrow Down)
' > More Commands > Customize Ribbon
' Check > "Developer" (RHS Near Bottom)
' > OK
' Developer (tab)
' Visual Basic
' ###########################################
' Open the VBA Editor (Step #1 = Complete)
' ###########################################
' ###########################################
' Copy & Paste VBA Code as Macro Module (Step #2)
' ###########################################
' Insert > Module
' Copy & Paste (VBA Code)
' Close (Module Editor)
' Close (VBA Editor)
' ###########################################
' Copy & Paste VBA Code as Macro Module (Step #2 = Complete)
' ###########################################
' ###########################################
' Run Macro (Step #3 = Complete)
' ###########################################
' > View (tab)
' > Macros
' > Select Macro (i.e. "PrintPreps")
' > Run
' ###########################################
' Run Macro (Step #3 = Complete)
' ###########################################
Note:
When Saving Changes,
it may prompt you to save as a "Macro-Free Presentation"
Simply Select "Yes"
Many PowerPoints contain :
Colorful Backgrounds (White Background = Saves Ink)
Background Designs (No Design = Saves Ink)
White (or Light Color) Text (Incompatible w/ White Background)
White (or Light Color) Table Borders (Incompatible w/ White Background)
Text Shadow Effects (Best w/ Light Color Text, Blurry w/ Black Text)
These colors / effects can exist in both what VBA recognizes as Table(s) or TextFrame(s)
Existing Solutions are Inadequate :
i.e. 1. Changing the Theme results in Changing Font Styles and moving objects around such that timely manual formatting is required.
2. Changing the Master Slide Background leaves text and Table borders requiring manual formatting (Timely Manual Process)
3. Changing the Print output to grey-scale or Black and White (Lose meanings and emphasis of Color objects, & print background design outlines)
I've compiled a VBA script that can prepare an entire PowerPoint for printing in "One Easy Click".
It does not change Font Style and therefore does not move objects around.
It removes background designs.
It changes background colors to White
It Changes Light Color Text to Black
It Changes Table borders to Black
It leaves most text colors as their original colors, so you have the meanings behind the colors, where needed.
It does not save changes automatically, so it can be tested and reverted if needed. Changes can be saved manually, per usual.
It's exactly what I was wanting (works perfectly for my needs, so I'm sharing).
Give it a try.
Let me know if any improvements are needed.
I'm a student, so I might not reply quickly, but others might help.
Below = Code, then Directions for use (below the Code)
Option Explicit
Sub PrintPreps()
' ###########################################
' View > Slide Master > BG Styles > Format BG > Solid Fill
' ###########################################
ActivePresentation.SlideMaster.Background.Fill.Solid
' ###########################################
' ###########################################
' View > Slide Master > BG Styles > Format BG > White BG
' ###########################################
ActivePresentation.SlideMaster.Background.Fill.ForeColor.RGB = RGB(255, 255, 255)
ActivePresentation.SlideMaster.Background.Fill.BackColor.RGB = RGB(255, 255, 255)
' ###########################################
' ###########################################
' Variable Prep Sets
' ###########################################
Dim oSld As Slide
Dim oShp As Shape
Dim oTbl As Table
Dim I As Long
Dim J As Long
Dim x As Long
Dim R As Long
Dim C As Long
' ###########################################
' ###########################################
' (Open Loop) For Ea. Slide One by One
' ###########################################
For Each oSld In ActivePresentation.Slides
' ###########################################
' ###########################################
' View > Slide Master > BG Styles > Format BG > Hide BG Graphics
' ###########################################
oSld.DisplayMasterShapes = msoFalse
' ###########################################
' ###########################################
' (Open Loop) For Ea. Shape One by One
' ###########################################
For Each oShp In oSld.Shapes
' ###########################################
' ###########################################
' Tables (Open)
' ###########################################
If oShp.HasTable Then
Set oTbl = oShp.Table
' ###########################################
' All Table Borders / Frames to Black (Open)
' ###########################################
For r = 1 To oTbl.Rows.Count
For c = 1 To oTbl.Columns.Count
With oTbl.Cell(r, c)
.Borders(ppBorderTop).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderBottom).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderLeft).ForeColor.RGB = RGB(0, 0, 0)
.Borders(ppBorderRight).ForeColor.RGB = RGB(0, 0, 0)
End With
Next c
Next r
' ###########################################
' All Table Borders / Frames to Black (Closed)
' ###########################################
' ###########################################
' All Table "Light Color Text" to Black
' & remove Text Shadow (Open)
' ###########################################
For I = 1 To oTbl.Columns.Count
For J = 1 To oTbl.Rows.Count
With oTbl.Cell(J, I).Shape.TextFrame.TextRange.Font
.Shadow = msoFalse
oShp.Shadow.Visible = msoFalse
End With
With oTbl.Cell(J, I).Shape.TextFrame.TextRange
For x = .Runs.Count To 1 Step -1
If .Runs(x).Font.Color.RGB >= RGB(200, 200, 200) Then
.Runs(x).Font.Color.RGB = RGB(0, 0, 0)
End If
Next x
End With
Next J
Next I
' ###########################################
' All Table "Light Color Text" to Black
' & remove Text Shadow (Closed)
' ###########################################
End If ' HasTable
' ###########################################
' Tables (Closed)
' ###########################################
' ###########################################
' All TextFrames "Light Color Text" to Black
' & remove Text Shadow (Open)
' ###########################################
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Font.Shadow = msoFalse
oShp.Shadow.Visible = msoFalse
With oShp.TextFrame.TextRange
For x = .Runs.Count To 1 Step -1
If .Runs(x).Font.Color.RGB >= RGB(200, 200, 200) Then
.Runs(x).Font.Color.RGB = RGB(0, 0, 0)
End If
Next x
End With
End If ' HasText
End If ' HasTextFrame
' ###########################################
' All TextFrames "Light Color Text" to Black
' & remove Text Shadow (Closed)
' ###########################################
' ###########################################
' (Repeat / Close Loop) For Ea. Shape One by One
' ###########################################
Next oShp
' ###########################################
' ###########################################
' (Repeat / Close Loop) For Ea. Slide One by One
' ###########################################
Next oSld
' ###########################################
End Sub
Instructions : How to Use VBA Code :
' ###########################################
' Open the VBA Editor (Step #1)
' ###########################################
' Option 1 :
' Press "Alt + F11"
' Option 2 (In cases where "Alt + F11" fail, i.e. at a school computer) :
' > Customize Quick Access Toolbar (Upper Left Arrow Down)
' > More Commands > Customize Ribbon
' Check > "Developer" (RHS Near Bottom)
' > OK
' Developer (tab)
' Visual Basic
' ###########################################
' Open the VBA Editor (Step #1 = Complete)
' ###########################################
' ###########################################
' Copy & Paste VBA Code as Macro Module (Step #2)
' ###########################################
' Insert > Module
' Copy & Paste (VBA Code)
' Close (Module Editor)
' Close (VBA Editor)
' ###########################################
' Copy & Paste VBA Code as Macro Module (Step #2 = Complete)
' ###########################################
' ###########################################
' Run Macro (Step #3 = Complete)
' ###########################################
' > View (tab)
' > Macros
' > Select Macro (i.e. "PrintPreps")
' > Run
' ###########################################
' Run Macro (Step #3 = Complete)
' ###########################################
Note:
When Saving Changes,
it may prompt you to save as a "Macro-Free Presentation"
Simply Select "Yes"