PowerPoint 2002 supports multiple masters, it's been a long requested feature. If you copy and paste slides thru the user interface, you get a smart tag option which gives you an option to retain source formatting of the slides being pasted/inserted. The smart tags cannot be manipulated in any way. The code snippet below explains how to copy slides while still retaining source formatting. Once you copy the slide, you can get a reference of the source slide design and set it to the target slide. This will add that design into the target presentation's design collection. You need to copy the color scheme of the source slide to ensure that the shape which follow the color scheme retain the same colors once copied.
' Copyright ©1999-2007 Shyam Pillai, All Rights Reserved.
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
Option Explicit Sub CopyWithSourceFormating()
Dim oSource As Presentation
Dim oTarget As Presentation
Dim oSlide As Slide
Dim dlgOpen As FileDialog
Dim bMasterShapes As Boolean
Set oTarget = ActivePresentation
Set dlgOpen = Application.FileDialog(msoFileDialogOpen) With dlgOpen
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Presentations", "*.ppt,*.pps"
.Title = "Select Presentation to import"
If .Show = -1 Then
Set oSource = Presentations.Open(.SelectedItems(1), , , False)
End If
If oSource Is Nothing Then Exit Sub
End With
For Each oSlide In oSource.Slides
oSlide.Copy
With oTarget.Slides.Paste
.Design = oSlide.Design
' Apply the color scheme only after you have applied
' the design, else it won't give the desired results.
.ColorScheme = oSlide.ColorScheme
' Additional processing for slides which don't follow
' the master background
If oSlide.FollowMasterBackground = False Then
.FollowMasterBackground = False
With .Background.Fill
.Visible = oSlide.Background.Fill.Visible
.ForeColor = oSlide.Background.Fill.ForeColor
.BackColor = oSlide.Background.Fill.BackColor
End With
Select Case oSlide.Background.Fill.Type
Case Is = msoFillTextured
Select Case oSlide.Background.Fill.TextureType
Case Is = msoTexturePreset
.Background.Fill.PresetTextured _
(oSlide.Background.Fill.PresetTexture)
Case Is = msoTextureUserDefined
' TextureName gives only the filename
' and not the path to the custom texture file used.
' We could do it the same way we handle picture fill.
End Select
Case Is = msoFillSolid
.Background.Fill.Transparency = 0#
.Background.Fill.Solid
Case Is = msoFillPicture
' No way to get the picture so export the slide image.
With oSlide
If .Shapes.Count>0 Then .Shapes.Range.Visible=False
bMasterShapes = .DisplayMasterShapes
.DisplayMasterShapes = False
.Export oSource.Path & .SlideID & ".png", "PNG"
End With
.Background.Fill.UserPicture _
oSource.Path & oSlide.SlideID & ".png"
Kill (oSource.Path & oSlide.SlideID & ".png")
With oSlide
.DisplayMasterShapes = bMasterShapes
If .Shapes.Count>0 Then .Shapes.Range.Visible= True
End With Case Is = msoFillPatterned
.Background.Fill.Patterned _
(oSlide.Background.Fill.Pattern)
Case Is = msoFillGradient
Select Case oSlide.Background.Fill.GradientColorType
Case Is = msoGradientTwoColors
.Background.Fill.TwoColorGradient _
oSlide.Background.Fill.GradientStyle, _
oSlide.Background.Fill.GradientVariant
Case Is = msoGradientPresetColors
.Background.Fill.PresetGradient _
oSlide.Background.Fill.GradientStyle, _
oSlide.Background.Fill.GradientVariant, _
oSlide.Background.Fill.PresetGradientType
Case Is = msoGradientOneColor
.Background.Fill.OneColorGradient _
oSlide.Background.Fill.GradientStyle, _
oSlide.Background.Fill.GradientVariant, _
oSlide.Background.Fill.GradientDegree
End Select
Case Is = msoFillBackground
' Only applicable to shapes.
End Select
End If
End With
Next oSlide
oSource.Close
Set oSource = Nothing
End Sub |