| 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
|
|---|
