-
Notifications
You must be signed in to change notification settings - Fork 1
/
PowerpointCreator.txt
173 lines (161 loc) · 6.18 KB
/
PowerpointCreator.txt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Sub CreatePresentation()
Dim FileName As String
Dim ImageName As String
Dim DefaultTradSize As Integer
Dim DefaultSimpSize As Integer
Dim DefaultPadding As Integer
Dim FontName As String
Dim TradBold As Boolean
Dim SimpBold As Boolean
Dim TradRed As Integer
Dim TradBlue As Integer
Dim TradGreen As Integer
Dim SimpRed As Integer
Dim SimpBlue As Integer
Dim SimpGreen As Integer
Dim ColumnNum As Integer
' PARAMETERS
FileName = "Output.txt"
ImageName = "home.png"
DefaultTradSize = 200
DefaultSimpSize = 200
DefaultPadding = 0
FontName = "SimSun"
TradBold = True
SimpBold = True
TradRed = 0
TradBlue = 0
TradGreen = 0
SimpRed = 0
SimpBlue = 255
SimpGreen = 0
ColumnNum = 20
' **********Do not touch code below***********
FileName = ActivePresentation.Path & "\" & FileName
ImageName = ActivePresentation.Path & "\" & ImageName
' Dim FileNum As Integer
Dim DataLineRaw As Variant
Dim DataLineTrad As String
Dim DataLineSimp As String
Dim Length As Integer
Dim Count As Integer
Dim SlideCount As Integer
Dim Width As Integer
Dim Height As Integer
ActivePresentation.PageSetup.SlideHeight = 600
ActivePresentation.PageSetup.SlideWidth = 800
Width = ActivePresentation.PageSetup.SlideWidth
Height = ActivePresentation.PageSetup.SlideHeight
Count = 0
SlideCount = 2
' FileNum = FreeFile()
' Open FileName For Input As #FileNum
Dim adoStream As ADODB.Stream
Dim var_String As Variant
Set adoStream = New ADODB.Stream
adoStream.Charset = "UTF-8"
adoStream.Open
adoStream.LoadFromFile FileName 'change this to point to your text file
var_String = Split(adoStream.ReadText, vbCrLf) 'split entire file into array - lines delimited by CRLF
For Each DataLineRaw In var_String
If Count Mod 2 = 0 Then
DataLineTrad = CStr(DataLineRaw)
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[\u0000-\u4E00]+"
DataLineTrad = .Replace(DataLineTrad, vbNullString)
End With
End If
If Count Mod 2 = 1 Then
DataLineSimp = CStr(DataLineRaw)
' Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[\u0000-\u4E00]+"
DataLineSimp = .Replace(DataLineSimp, vbNullString)
End With
Length = Len(DataLineTrad)
Dim Current As Slide
Dim oLayout As CustomLayout
Set oLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1)
Set Current = ActivePresentation.Slides.AddSlide(SlideCount, oLayout)
Dim TradBox As Shape
Set TradBox = Current.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 1000, 0)
TradBox.TextFrame.AutoSize = ppAutoSizeShapeToFitText
TradBox.TextFrame.HorizontalAnchor = msoAnchorCenter
TradBox.TextFrame.TextRange.Text = DataLineTrad
Dim TradSize As Integer
Dim SimpSize As Integer
If Length < 4 Then
TradSize = DefaultTradSize
SimpSize = DefaultSimpSize
Else
TradSize = DefaultTradSize * 3 \ Length
SimpSize = DefaultSimpSize * 3 \ Length
End If
With TradBox.TextFrame.TextRange.Font
.Size = TradSize
.Name = FontName
.Bold = TradBold
.Color.RGB = RGB(TradRed, TradGreen, TradBlue)
End With
If StrComp(DataLineSimp, DataLineTrad) = 0 Then
With TradBox
' .TextAlign = 2
.Left = Width / 2 - .Width / 2
.Top = Height / 2 - .Height / 2
End With
Else
Dim SimpBox As Shape
Set SimpBox = Current.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 1000, 0)
SimpBox.TextFrame.AutoSize = ppAutoSizeShapeToFitText
SimpBox.TextFrame.HorizontalAnchor = msoAnchorCenter
SimpBox.TextFrame.TextRange.Text = DataLineSimp
With SimpBox.TextFrame.TextRange.Font
.Size = SimpSize
.Name = FontName
.Bold = SimpBold
.Color.RGB = RGB(SimpRed, SimpGreen, SimpBlue)
End With
With TradBox
' .TextAlign = 2
.Left = Width / 2 - .Width / 2
.Top = Height / 2 - (.Height + SimpBox.Height + DefaultPadding) / 2
End With
With SimpBox
' .TextAlign = 2
.Left = Width / 2 - .Width / 2
.Top = Height / 2 + DefaultPadding / 2
End With
End If
Dim Image As Shape
Set Image = Current.Shapes.AddPicture(ImageName, msoFalse, msoTrue, Width - 50, Height - 50, 30, 30)
With Image.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = ""
.Hyperlink.SubAddress = 1
End With
SlideCount = SlideCount + 1
End If
Count = Count + 1
Next
' Table of contents
Dim TOC As Shape
Set TOC = ActivePresentation.Slides(1).Shapes.AddTable((SlideCount - 2) \ ColumnNum + 1, ColumnNum, 10, 10, 300, 300)
For i = 1 To (SlideCount - 2) \ ColumnNum + 1
For j = 1 To ColumnNum
k = (i - 1) * 20 + j
If k < SlideCount - 1 Then
TOC.Table.Cell(i, j).Shape.TextFrame.TextRange.Text = k
With TOC.Table.Cell(i, j).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = ""
.Hyperlink.SubAddress = k + 1
End With
End If
Next j
Next i
End Sub