Fairly long code here that I inherited. This code creates a title text box on each slide that says title = "[XXXXXX]".
I need to change the title for each slide, so for example, slide 1 needs to delete the [XXXXXX] and replace it with "Executive Summary". Slide 2 needs to replace the [XXXXXX] with "Borrower Characteristics". Slide 3 needs to replace "[XXXXXX]" with something else.
How do I adjust this code so that I can adjust the specific language needed for each individual slide?
Thanks!
'Create PowerPoint Final
Option Explicit
Dim title As String
Sub CopyChartsToPowerPoint()
'########################
' Revised: Desc
' 2023_01_22: Add macro
'########################
'// excel variables/objects
Dim wb As Workbook
Dim source_sheet As Worksheet
Dim chart_obj As ChartObject
Dim i As Long, last_row As Long, tracker As Long
'// powerpoint variables/objects
Dim pp_app As PowerPoint.Application
Dim pp_presentation As Presentation
Dim pp_slide As Slide
Dim pp_shape As Object
Dim pp_slider_tracker As Long, n As Long
Set wb = ThisWorkbook
Set source_sheet = wb.Worksheets("portfolio_charts")
Set pp_app = New PowerPoint.Application
Set pp_presentation = pp_app.Presentations.Add
pp_slider_tracker = 1
n = 41
title = "[XXXXXX]"
last_row = source_sheet.Cells(Rows.Count, "A").End(xlUp).Row
'Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)
Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutCustom)
For i = 1 To last_row
' Stop
' Debug.Assert i < 20
'
' If i Mod 37 = 5 Or i Mod 37 = 9 Or i Mod 37 = 13 Or i Mod 37 = 17 _
' Or i Mod 37 = 21 Or (i Mod 37 > 23 And i Mod 37 < 37) Or i Mod 37 = 0 Or (i Mod 37 = 1 And pp_slider_tracker > 1) Then
If (i Mod n = 1 And pp_slider_tracker > 1) Or i Mod n = 5 Or i Mod n = 7 Or i Mod n = 10 Or i Mod n = 13 Or i Mod n = 16 Or i Mod n = 18 Or i Mod n = 22 Or i Mod n = 24 Or _
(i Mod n > 27 Or i Mod n = 0) Then
pp_slider_tracker = pp_slider_tracker 1
Set pp_slide = pp_presentation.Slides.Add(pp_slider_tracker, ppLayoutBlank)
End If
Set chart_obj = source_sheet.ChartObjects(source_sheet.Cells(i, "A").Value)
chart_obj.Chart.ChartArea.Copy
'Set pp_shape = pp_slide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
Set pp_shape = pp_slide.Shapes.Paste
Select Case i Mod n
'// four/three charts
Case 1, 7, 10, 13, 18, 24
Call position_chart_top_left(pp_shape)
Call insert_title(pp_slide)
Call insert_h_line_1(pp_slide)
Call insert_h_line_2(pp_slide)
Call insert_v_line_1(pp_slide)
'// top right
Case 2, 8, 11, 14, 19, 25
Call position_chart_top_right(pp_shape)
'// bottom left
Case 3, 9, 12, 15, 20, 26
Call position_chart_bottom_left(pp_shape)
'// bottom right
Case 4, 21, 27
Call position_chart_bottom_right(pp_shape)
'// two charts
Case 5, 16, 22
Call position_chart_top_left(pp_shape)
Call position_chart_double_chart(pp_shape)
Call insert_title(pp_slide)
Call insert_h_line_1(pp_slide)
Call insert_v_line_1(pp_slide)
pp_shape.Height = 325
'// two charts
Case 6, 17, 23
Call position_chart_top_right(pp_shape)
Call position_chart_double_chart(pp_shape)
Call insert_title(pp_slide)
Call insert_h_line_1(pp_slide)
Call insert_v_line_1(pp_slide)
pp_shape.Height = 325
Case 28 To n, 0
Call position_chart_single_chart(pp_shape)
Call insert_title(pp_slide)
Call insert_h_line_1(pp_slide)
pp_shape.Height = 375
End Select
Application.Wait (Now TimeValue("00:00:01"))
Next i
End Sub
Private Sub position_chart_top_left(ByVal pp_shape As Object)
pp_shape.Left = 66
pp_shape.Top = 86
End Sub
Private Sub position_chart_top_right(ByVal pp_shape As Object)
pp_shape.Left = 510
pp_shape.Top = 86
End Sub
Private Sub position_chart_bottom_left(ByVal pp_shape As Object)
pp_shape.Left = 66
pp_shape.Top = 306
End Sub
Private Sub position_chart_bottom_right(ByVal pp_shape As Object)
pp_shape.Left = 510
pp_shape.Top = 306
End Sub
Private Sub position_chart_single_chart(ByVal pp_shape As Object)
pp_shape.Left = 127
pp_shape.Top = 90
pp_shape.Width = 706
pp_shape.Height = 300
End Sub
Private Sub position_chart_double_chart(ByVal pp_shape As Object)
pp_shape.Top = 90
pp_shape.Height = 300
End Sub
Private Sub insert_title(ByVal pp_slide As Slide)
Dim slide_title As Object
Set slide_title = pp_slide.Shapes.AddTextbox(1, 34.36292, -2.670787, 900, 90)
With slide_title
.Height = 54
.Left = 34.36292
.Top = 15
.Width = 190
.TextFrame.TextRange.Text = title
.TextFrame.TextRange.Font.Bold = True
.TextFrame.TextRange.Font.Size = 20
.TextFrame.TextRange.Font.Color = RGB(0, 133, 85)
End With
End Sub
Private Sub insert_h_line_1(ByVal pp_slide As Slide)
Dim line1 As Object
Set line1 = pp_slide.Shapes.AddLine(beginx:=10, beginy:=57.6, endx:=924, endy:=57.6).Line
With line1
.Weight = 2
.Parent.Left = 18
.Parent.Top = 48
.ForeColor.RGB = RGB(140, 140, 140)
With .Parent.Shadow
.Transparency = 0.6
.Visible = True
.Style = msoShadowStyleOuterShadow
End With
End With
End Sub
Private Sub insert_h_line_2(ByVal pp_slide As Slide)
Dim line2 As Object
Set line2 = pp_slide.Shapes.AddLine(beginx:=10, beginy:=57.6, endx:=924, endy:=57.6).Line
With line2
.Weight = 2
.Parent.Left = 18
.Parent.Top = 285
.ForeColor.RGB = RGB(140, 140, 140)
With .Parent.Shadow
.Transparency = 0.6
.Visible = True
.Style = msoShadowStyleOuterShadow
End With
End With
End Sub
Private Sub insert_v_line_1(ByVal pp_slide As Slide)
Dim line3 As Object
Set line3 = pp_slide.Shapes.AddLine(beginx:=10, beginy:=10, endx:=924, endy:=10).Line
With line3
.Weight = 2
.Parent.Width = 430
.Parent.Rotation = 90
.Parent.Left = 264
.Parent.Top = 268
.ForeColor.RGB = RGB(140, 140, 140)
With .Parent.Shadow
.Transparency = 0.6
.Visible = True
.Style = msoShadowStyleOuterShadow
End With
End With
End Sub
CodePudding user response：
Add a sheet named "title", assign it to wsTitle and put text in column A. Eg "Executive Summary" in A1,"Borrower" in A2 etc. Then in Sub insert_title() change line
'.TextFrame.TextRange.Text = title
.TextFrame.TextRange.Text = wsTitle.Cells(pp_slide.SlideIndex,"A")
You can put different languages in other columns and change "A" accordingly.