1 | VERSION 5.00
|
---|
2 | Begin VB.Form Form1
|
---|
3 | Caption = "Form1"
|
---|
4 | ClientHeight = 1380
|
---|
5 | ClientLeft = 60
|
---|
6 | ClientTop = 450
|
---|
7 | ClientWidth = 3825
|
---|
8 | LinkTopic = "Form1"
|
---|
9 | ScaleHeight = 1380
|
---|
10 | ScaleWidth = 3825
|
---|
11 | StartUpPosition = 3 'Windows Default
|
---|
12 | Begin VB.Label W
|
---|
13 | Alignment = 2 'Center
|
---|
14 | Caption = "Word to HTML"
|
---|
15 | BeginProperty Font
|
---|
16 | Name = "MS Sans Serif"
|
---|
17 | Size = 24
|
---|
18 | Charset = 0
|
---|
19 | Weight = 400
|
---|
20 | Underline = 0 'False
|
---|
21 | Italic = 0 'False
|
---|
22 | Strikethrough = 0 'False
|
---|
23 | EndProperty
|
---|
24 | Height = 615
|
---|
25 | Left = 360
|
---|
26 | TabIndex = 0
|
---|
27 | Top = 360
|
---|
28 | Width = 3375
|
---|
29 | End
|
---|
30 | End
|
---|
31 | Attribute VB_Name = "Form1"
|
---|
32 | Attribute VB_GlobalNameSpace = False
|
---|
33 | Attribute VB_Creatable = False
|
---|
34 | Attribute VB_PredeclaredId = True
|
---|
35 | Attribute VB_Exposed = False
|
---|
36 | Private Sub Form_Load()
|
---|
37 | Dim pa As PowerPoint.Application
|
---|
38 | Set pa = CreateObject("PowerPoint.Application")
|
---|
39 | pa.Visible = True
|
---|
40 |
|
---|
41 | Dim ppts As PowerPoint.Presentations
|
---|
42 | Set ppts = pa.Presentations
|
---|
43 |
|
---|
44 | htm = False
|
---|
45 | jpg = False
|
---|
46 | gif = False
|
---|
47 | old = False
|
---|
48 | png = False
|
---|
49 | meta = False
|
---|
50 |
|
---|
51 | cmdln = Command()
|
---|
52 | 'cmdln = "-g H:\chi\Visual Basic\ForumPres270404.ppt H:\chi\Visual Basic\tmp\ForumPres270404"
|
---|
53 | outputdir = getoutput(cmdln)
|
---|
54 | File = Left(cmdln, InStr(cmdln, ".ppt") + 3)
|
---|
55 | item_file = Left(cmdln, InStr(cmdln, ".ppt"))
|
---|
56 | args = getargs(File)
|
---|
57 | direc = getdir(File)
|
---|
58 | File = getfile(File)
|
---|
59 | item_file = getfile(item_file)
|
---|
60 |
|
---|
61 | If InStr(args, "h") Then htm = True
|
---|
62 | If InStr(args, "j") Then jpg = True
|
---|
63 | If InStr(args, "g") Then gif = True
|
---|
64 | If InStr(args, "p") Then png = True
|
---|
65 | If InStr(args, "o") Then old = True
|
---|
66 | If InStr(args, "m") Then meta = True
|
---|
67 |
|
---|
68 | Dim item, text
|
---|
69 | 'As Object
|
---|
70 | Dim fso
|
---|
71 | Set fso = CreateObject("Scripting.FileSystemObject")
|
---|
72 |
|
---|
73 | ' Modified for apply to GSII environment setting
|
---|
74 | output_tmp = Left(outputdir, InStr(outputdir, "\tmp") + 3)
|
---|
75 | If Not fso.FolderExists(output_tmp) Then
|
---|
76 | fso.CreateFolder (output_tmp)
|
---|
77 | If Not fso.FolderExists(outputdir) Then
|
---|
78 | fso.CreateFolder (outputdir)
|
---|
79 | End If
|
---|
80 | Else
|
---|
81 | If Not fso.FolderExists(outputdir) Then
|
---|
82 | fso.CreateFolder (outputdir)
|
---|
83 | End If
|
---|
84 | End If
|
---|
85 |
|
---|
86 | 'generate document_name.item file
|
---|
87 | Set item = fso.CreateTextFile(outputdir + "\" + item_file + "item", ForWriting, True)
|
---|
88 | 'Set item = CreateObject("ADODB.Stream")
|
---|
89 | 'item.Open
|
---|
90 | 'item.Position = 0
|
---|
91 | 'item.Charset = "UTF-8"
|
---|
92 |
|
---|
93 | 'Print #3, "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?>"
|
---|
94 | 'Print #3, "<!DOCTYPE DirectoryMetadata SYSTEM " + Chr(34) + "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd" + Chr(34) + ">"
|
---|
95 | 'Print #1, "<PagedDocument>"
|
---|
96 | item.WriteLine ("<PagedDocument>")
|
---|
97 | 'item.WriteText "<PagedDocument>", 1
|
---|
98 | source = direc + File
|
---|
99 | ppts.Open (source)
|
---|
100 |
|
---|
101 | 'do stuff
|
---|
102 | n = 1
|
---|
103 | Dim slide_shape As Shape
|
---|
104 | j = 2
|
---|
105 | For slide_count = 1 To ppts(1).Slides.Count
|
---|
106 | current_slide = ppts(1).Slides(slide_count).Name
|
---|
107 | 'generate a text version
|
---|
108 | Set text = fso.CreateTextFile(outputdir + "\Slide" + CStr(slide_count) + ".txt", ForWriting, True)
|
---|
109 | 'Set text = CreateObject("ADODB.Stream")
|
---|
110 | 'text.Open
|
---|
111 | 'text.Position = 0
|
---|
112 | 'text.Charset = "UTF-8"
|
---|
113 | If (ppts(1).Slides(slide_count).Shapes.HasTitle) Then
|
---|
114 | slide_title = ppts(1).Slides(slide_count).Shapes.Title.TextFrame.TextRange
|
---|
115 | Else
|
---|
116 | slide_title = ppts(1).Slides(slide_count).Name
|
---|
117 | End If
|
---|
118 | slide_text = ""
|
---|
119 | found_text = True
|
---|
120 | For iShape = 1 To ppts(1).Slides(slide_count).Shapes.Count
|
---|
121 | If (ppts(1).Slides(slide_count).Shapes(iShape).TextFrame.HasText) Then
|
---|
122 | slide_text = ppts(1).Slides(slide_count).Shapes(iShape).TextFrame.TextRange.text
|
---|
123 | 'MsgBox ("Slide_text:" + slide_text)
|
---|
124 | If slide_text <> "" Then
|
---|
125 | text.WriteLine (slide_text)
|
---|
126 | 'text.WriteText (slide_text)
|
---|
127 | Else
|
---|
128 | text.WriteLine ("This slide has no text")
|
---|
129 | 'text.WriteText ("This slide has no text")
|
---|
130 | End If
|
---|
131 | End If
|
---|
132 | Next iShape
|
---|
133 | 'text_file = outputdir + "\Slide" + CStr(slide_count) + ".txt"
|
---|
134 | 'text.SaveToFile text_file
|
---|
135 | 'text.Close
|
---|
136 | 'j = j + 1
|
---|
137 | If ppts(1).Slides.Count >= 1 And slide_count < ppts(1).Slides.Count Then
|
---|
138 | next_slide = ppts(1).Slides(slide_count + 1).Name
|
---|
139 | Else
|
---|
140 | nextf = " "
|
---|
141 | End If
|
---|
142 | If htm Then
|
---|
143 | ' Not developed for convert to html yet
|
---|
144 | 'Currently, if the user choose to convert the PPT to the html file
|
---|
145 | 'We will only allow users to use the open source method
|
---|
146 | End If
|
---|
147 | If gif Then
|
---|
148 | current_slide = "Slide" + CStr(n)
|
---|
149 | If nextf <> " " Then
|
---|
150 | nextf = outputdir + "\" + "Slide" + CStr(n + 1)
|
---|
151 | End If
|
---|
152 | prevhtml = outputdir + "\" + current_slide + ".gif"
|
---|
153 | If slide_text = "" Then
|
---|
154 | itemxml item, current_slide + ".gif", "", n, slide_title
|
---|
155 | Else
|
---|
156 | itemxml item, current_slide + ".gif", current_slide + ".txt", n, slide_title
|
---|
157 | End If
|
---|
158 | End If
|
---|
159 | If jpg Then
|
---|
160 | current_slide = "Slide" + CStr(n)
|
---|
161 | If nextf <> " " Then
|
---|
162 | nextf = outputdir + "\" + "Slide" + CStr(n + 1)
|
---|
163 | End If
|
---|
164 | prevhtml = outputdir + "\" + current_slide + ".jpg"
|
---|
165 | If slide_text = "" Then
|
---|
166 | itemxml item, current_slide + ".jpg", "", n, slide_title
|
---|
167 | Else
|
---|
168 | itemxml item, current_slide + ".jpg", current_slide + ".txt", n, slide_title
|
---|
169 | End If
|
---|
170 | End If
|
---|
171 | If png Then
|
---|
172 | current_slide = "Slide" + CStr(n)
|
---|
173 | If nextf <> " " Then
|
---|
174 | nextf = outputdir + "\" + "Slide" + CStr(n + 1)
|
---|
175 | End If
|
---|
176 | prevhtml = outputdir + "\" + current_slide + ".png"
|
---|
177 | If slide_text = "" Then
|
---|
178 | itemxml item, current_slide + ".png", "", n, slide_title
|
---|
179 | Else
|
---|
180 | itemxml item, current_slide + ".png", current_slide + ".txt", n, slide_title
|
---|
181 | End If
|
---|
182 | End If
|
---|
183 | n = n + 1
|
---|
184 | item.WriteLine (" </Page>")
|
---|
185 | 'item.WriteText " </Page>", 1
|
---|
186 | Next
|
---|
187 | i = 0
|
---|
188 | If htm Then
|
---|
189 | 'ppts(1).SaveAs outputdir, ppSaveAsHTMLv3
|
---|
190 | ElseIf gif Then
|
---|
191 | ppts(1).SaveAs outputdir, ppSaveAsGIF
|
---|
192 | ElseIf jpg Then
|
---|
193 | ppts(1).SaveAs outputdir, ppSaveAsJPG
|
---|
194 | ElseIf png Then
|
---|
195 | ppts(1).SaveAs outputdir, ppSaveAsPNG
|
---|
196 | End If
|
---|
197 |
|
---|
198 | item.WriteLine ("</PagedDocument>")
|
---|
199 | 'item.WriteText "</PagedDocument>", 1
|
---|
200 | 'objStream.SaveToFile pstrFile
|
---|
201 | 'item.SaveToFile outputdir + "\" + item_file + "item"
|
---|
202 | item.Close
|
---|
203 | ppts(1).Close
|
---|
204 | Set fso = Nothing
|
---|
205 | Set text = Nothing
|
---|
206 | Set item = Nothing
|
---|
207 | pa.Quit
|
---|
208 | End
|
---|
209 | End Sub
|
---|
210 | Function getoutput(line)
|
---|
211 | cmdln = line
|
---|
212 | While InStr(cmdln, ".ppt")
|
---|
213 | cmdln = LTrim(RTrim(Right(cmdln, Len(cmdln) - (InStr(cmdln, ".ppt") + 3))))
|
---|
214 | Wend
|
---|
215 | getoutput = cmdln
|
---|
216 | End Function
|
---|
217 | Function getargs(line)
|
---|
218 | x = LTrim(line)
|
---|
219 | If InStr(x, "-") = 1 Then
|
---|
220 | getargs = Left(line, InStr(line, " "))
|
---|
221 | End If
|
---|
222 | End Function
|
---|
223 | Function getdir(line)
|
---|
224 | x = LTrim(Right(line, Len(line) - Len(getargs(line))))
|
---|
225 | If InStr(x, ":") <> 2 Then
|
---|
226 | direc = CurDir
|
---|
227 | If Right(direc, 1) <> "\" Then direc = direc + "\"
|
---|
228 | End If
|
---|
229 |
|
---|
230 | While InStr(x, "\")
|
---|
231 | direc = direc + Left(x, InStr(x, "\"))
|
---|
232 | x = Right(x, Len(x) - InStr(x, "\"))
|
---|
233 | Wend
|
---|
234 | getdir = direc
|
---|
235 | End Function
|
---|
236 | Function getfile(line)
|
---|
237 | x = LTrim(Right(line, Len(line) - Len(getargs(line))))
|
---|
238 | While InStr(x, "\")
|
---|
239 | x = Right(x, Len(x) - InStr(x, "\"))
|
---|
240 | Wend
|
---|
241 | getfile = x
|
---|
242 | End Function
|
---|
243 | Sub itemxml(out_item, thisfile, txtfile, num, slide_title)
|
---|
244 | out_item.WriteLine (" <Page pagenum=" + Chr(34) + CStr(num) + Chr(34) + " imgfile=" + Chr(34) + thisfile + Chr(34) + " txtfile=" + Chr(34) + txtfile + Chr(34) + ">")
|
---|
245 | 'out_item.WriteText " <Page pagenum=" + Chr(34) + CStr(num) + Chr(34) + " imgfile=" + Chr(34) + thisfile + Chr(34) + " txtfile=" + Chr(34) + txtfile + Chr(34) + ">", 1
|
---|
246 | If slide_title <> "" Then
|
---|
247 | out_item.WriteLine (" <Metadata name=" + Chr(34) + "Title" + Chr(34) + ">" + slide_title + "</Metadata>")
|
---|
248 | 'MsgBox ("Title:" + slide_title)
|
---|
249 | 'out_item.WriteText " <Metadata name=" + Chr(34) + "Title" + Chr(34) + ">" + slide_title + "</Metadata>", 1
|
---|
250 | End If
|
---|
251 | End Sub
|
---|
252 | Function checknext(filename, extention)
|
---|
253 | If filename = "" Then
|
---|
254 | checknext = ""
|
---|
255 | Else
|
---|
256 | checknext = filename + extention
|
---|
257 | End If
|
---|
258 | End Function
|
---|
259 | Function replaceStrings(f, c, W)
|
---|
260 | s = f
|
---|
261 | t = ""
|
---|
262 | While InStr(s, c)
|
---|
263 | t = t + Left(s, InStr(s, c) - 1) + W
|
---|
264 | s = Right(s, Len(s) - (InStr(s, c) + Len(c)) + 1)
|
---|
265 | Wend
|
---|
266 | replaceStrings = t + s
|
---|
267 | End Function
|
---|
268 | Function fixnum(s)
|
---|
269 | fixnum = String(4 - Len(s), "0") + s
|
---|
270 | End Function
|
---|