├── Data.xlsx ├── E2P.docx ├── E2P.pdf ├── E2P.vbs ├── LICENSE ├── Presentation.pptx └── README.md /Data.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/peterpostmann/Excel-to-Powerpoint-bridge/c22281a301a52ea826db47ce032c87c7c2ae8fa6/Data.xlsx -------------------------------------------------------------------------------- /E2P.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/peterpostmann/Excel-to-Powerpoint-bridge/c22281a301a52ea826db47ce032c87c7c2ae8fa6/E2P.docx -------------------------------------------------------------------------------- /E2P.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/peterpostmann/Excel-to-Powerpoint-bridge/c22281a301a52ea826db47ce032c87c7c2ae8fa6/E2P.pdf -------------------------------------------------------------------------------- /E2P.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' Excel-2-Powerpoint Bridge 3 | ' 4 | ' (c) 2016 Peter Postmann 5 | ' 6 | ' This project is licensed under the terms of the MIT license 7 | ' 8 | 9 | Dim ConsoleMode, colNamedArguments, saveJob, _ 10 | xlApp, xlBook, ppApp, ppPpt, ppFileName, _ 11 | xlFileName, xlTargetSheetName, xlTargetSheet, xlHeaderRow, xlFirstDataRow, xlFirstCol, xlIndexName, _ 12 | xlFirstCol_str, xlHeaderRow_str, xlFirstDataRow_str, ppTemplateSlideID_str, ppInsertAfterSlide_str, _ 13 | dictMapping, dictIDs, index, dictCommon, dictUpdated, dictShapeData, dictSlideIndex, _ 14 | ppTemplateSlideID, ppTemplateSlide, ppInsertAfterSlide 15 | 16 | ' Success? 17 | Dim success 18 | success = false 19 | Set xlApp = Nothing 20 | 21 | 'Declare progressbar and percentage complete 22 | Dim pb 23 | Dim pbCount 24 | Dim pbTotal 25 | 26 | 'Setup the initial progress bar 27 | Set pb = New ProgressBar 28 | 29 | ' Don't Display File/Open Dialog if started with cscript 30 | ConsoleMode = false 31 | 32 | ' Get Arguments 33 | Set colNamedArguments = WScript.Arguments.Named 34 | xlFileName = colNamedArguments.Item("xlFileName") 35 | xlTargetSheetName = colNamedArguments.Item("xlTargetSheetName") 36 | xlFirstCol_str = colNamedArguments.Item("xlFirstCol") 37 | xlHeaderRow_str = colNamedArguments.Item("xlHeaderRow") 38 | xlFirstDataRow_str = colNamedArguments.Item("xlFirstDataRow") 39 | ppFileName = colNamedArguments.Item("ppFileName") 40 | ppTemplateSlideID_str = colNamedArguments.Item("ppTemplateSlideID") 41 | ppInsertAfterSlide_str = colNamedArguments.Item("ppInsertAfterSlide") 42 | saveJob = colNamedArguments.Item("saveJob") 43 | 44 | Do 45 | 46 | ' Get Excel file name 47 | If xlFileName = "" Then 48 | xlFileName = SelectFile("Select Excel File") 49 | End IF 50 | If xlFileName = "" Then Exit Do 51 | 52 | ' Open workbook 53 | Set xlApp = CreateObject("Excel.Application") 54 | xlApp.Visible = True 55 | Set xlBook = xlApp.Workbooks.Open(xlFileName,,True) 56 | 57 | ' Get target sheet name and open it 58 | If xlTargetSheetName = "" Then 59 | xlTargetSheetName = xlBook.ActiveSheet.Name 60 | xlTargetSheetName = UserInput("Target sheet", "Target Sheet", xlTargetSheetName) 61 | End If 62 | Set xlTargetSheet = xlGetTargetSheet(xlBook, xlTargetSheetName) 63 | If xlTargetSheet Is Nothing Then Exit Do 64 | 65 | ' Get ColumnOffset 66 | If xlFirstCol_str = "" Then 67 | xlFirstCol = CInt(UserInput("First column", "", 1)) 68 | Else 69 | xlFirstCol = CInt(xlFirstCol_str) 70 | End If 71 | If xlFirstCol = "" Then Exit Do 72 | 73 | ' Get header row 74 | If xlHeaderRow_str = "" Then 75 | xlHeaderRow = xlGetHeaderRow(xlTargetSheet, xlFirstCol) 76 | xlHeaderRow = CInt(UserInput("Header row", "", xlHeaderRow)) 77 | Else 78 | xlHeaderRow = CInt(xlHeaderRow_str) 79 | End If 80 | If xlHeaderRow = "" Then Exit Do 81 | 82 | ' Get first data row 83 | If xlFirstDataRow_str = "" Then 84 | xlFirstDataRow = CInt(UserInput("First data row", "", xlHeaderRow + 1)) 85 | Else 86 | xlFirstDataRow = CInt(xlFirstDataRow_str) 87 | End If 88 | If xlFirstDataRow = "" Then Exit Do 89 | 90 | ' Get name of ID row 91 | xlIndexName = "{{" & xlTargetSheet.Cells(xlHeaderRow, xlFirstCol).Value & "}}" 92 | 93 | ' Create mapping {{header}} --> column number 94 | Set dictMapping = xlGetMapping(xlTargetSheet, xlHeaderRow, xlFirstCol) 95 | If dictMapping Is Nothing Then Exit Do 96 | 97 | ' Create mapping {ID} --> row number 98 | Set dictIDs = xlGetIDs(xlTargetSheet, xlFirstDataRow, xlFirstCol) 99 | If dictIDs Is Nothing Then Exit Do 100 | 101 | ' Create mapping {common_infos} --> data 102 | Set dictCommon = xlGetCommon(xlBook) 103 | If dictCommon Is Nothing Then Exit Do 104 | 105 | ' Get Powerpoiunt file name 106 | If ppFileName = "" Then 107 | ppFileName = SelectFile("Select Powerpoint File") 108 | End If 109 | If ppFileName = "" Then Exit Do 110 | 111 | ' Open presentation 112 | Set ppApp = CreateObject("Powerpoint.Application") 113 | Set ppPpt = ppApp.Presentations.Open(ppFileName) 114 | 115 | ' Get template slide 116 | If ppTemplateSlideID_str = "" Then 117 | ppTemplateSlideID = CInt(UserInput("Template Slide", "", 2)) 118 | Else 119 | ppTemplateSlideID = CInt(ppTemplateSlideID_str) 120 | End If 121 | Set ppTemplateSlide = ppPpt.Slides(ppTemplateSlideID) 122 | If ppTemplateSlide Is Nothing Then Exit Do 123 | 124 | ' Get insert position 125 | If ppInsertAfterSlide_str = "" Then 126 | ppInsertAfterSlide = ppPpt.Slides.Count 127 | ppInsertAfterSlide = UserInput("Insert new Slides after", "", ppInsertAfterSlide) 128 | Else 129 | ppInsertAfterSlide = CInt(ppInsertAfterSlide_str) 130 | End If 131 | If ppInsertAfterSlide <= 0 Then Exit Do 132 | 133 | If saveJob = "" Then 134 | saveJob = YesNoDialog("Save Job?", "Save Job") 135 | End If 136 | 137 | If saveJob = "y" Then 138 | 139 | WriteUTF8WithoutBOM "@chcp 65001" & vbCrLf & _ 140 | "wscript " & wscript.scriptname _ 141 | & " /xlFileName:" & chr(34) & xlFileName & chr(34) _ 142 | & " /xlTargetSheetName:" & chr(34) & xlTargetSheetName & chr(34) _ 143 | & " /xlFirstCol:" & xlFirstCol _ 144 | & " /xlHeaderRow:" & xlHeaderRow _ 145 | & " /xlFirstDataRow:" & xlFirstDataRow _ 146 | & " /ppFileName:" & chr(34) & ppFileName & chr(34) _ 147 | & " /ppTemplateSlideID:" & ppTemplateSlideID _ 148 | & " /ppInsertAfterSlide:" & ppInsertAfterSlide _ 149 | & " /saveJob:n" _ 150 | & vbCrLf, xlFileName & ".bat" 151 | 152 | 153 | 154 | End If 155 | 156 | ' Monitor updated SlideIndex: SlideIndex --> true/false 157 | Set dictUpdated = CreateObject("Scripting.Dictionary") 158 | 159 | ' Create mapping {ID} --> Shapes 160 | Set dictSlideIndex = CreateObject("Scripting.Dictionary") 161 | 162 | ' Create mapping {ID} --> Shapes 163 | Set dictShapeData = CreateObject("Scripting.Dictionary") 164 | 165 | ' Setup ProgressBar 166 | pb.Show() 167 | pb.NextTaks "Taks 1 of 2", "Parsing Presentation", ppPpt.Slides.Count 168 | 169 | ' Loop throug all Slides 170 | For Each Slide in ppPpt.Slides 171 | If Slide.SlideIndex <> ppTemplateSlideID Then 172 | 173 | Dim dictShapes, TargetID 174 | 175 | Set dictShapes = ppGetShapes(Slide.Shapes) 176 | TargetID = "" 177 | 178 | ' Check for each Shape 179 | For Each Shape in dictShapes.Items 180 | 181 | ' if binding exists 182 | IF Shape.Name = xlIndexName Then 183 | 184 | If TargetID <> "" Then 185 | WScript.Echo ("Fatal: Dublicated shape name! This should never happen.") 186 | Exit Do 187 | End If 188 | 189 | ' and request update 190 | TargetID = Shape.TextEffect.Text 191 | End If 192 | 193 | ' and updated common information --> updated 194 | If dictCommon.Exists(Shape.Name) Then 195 | Shape.TextEffect.Text = dictCommon(Shape.Name) 196 | End If 197 | 198 | Next 199 | 200 | ' Save target information 201 | If Not dictUpdated.Exists(TargetID) Then 202 | 203 | IF TargetID <> "" Then 204 | dictUpdated.add TargetID, false 205 | dictSlideIndex.add TargetID, Slide.SlideIndex 206 | dictShapeData.add TargetID, dictShapes 207 | End If 208 | 209 | Else 210 | WScript.Echo ("Warning: Dublicated binding. Skipping slide " & Slide.SlideIndex) 211 | End If 212 | 213 | End If 214 | 215 | pb.NextStep() 216 | 217 | Next 218 | 219 | ' Setup ProgressBar 220 | pb.NextTaks "Taks 2 of 2", "Copying Data", dictIDs.Count 221 | 222 | ' Loop throug data 223 | For xlRowNum = xlFirstDataRow To dictIDs.Count + xlFirstDataRow - 1 224 | 225 | Dim Slide, Shapes 226 | 227 | TargetId = CStr(xlTargetSheet.Cells(xlRowNum, xlFirstCol).Value) 228 | 229 | ' Get referance or create new slide 230 | If dictUpdated.Exists(TargetId) Then 231 | Set Slide = ppPpt.Slides(dictSlideIndex(TargetId)) 232 | Set Shapes = dictShapeData(TargetId) 233 | Else 234 | Set Slide = ppTemplateSlide.Duplicate 235 | ppInsertAfterSlide = ppInsertAfterSlide + 1 236 | Slide.MoveTo(ppInsertAfterSlide) 237 | Set Shapes = ppGetShapes(Slide.Shapes) 238 | End If 239 | 240 | ' Check for each shape 241 | For Each Shape in Shapes.Items 242 | 243 | ' if mapping exists 244 | If dictMapping.Exists(Shape.Name) Then 245 | 246 | ' check if target has TextEffect property 247 | ' https://msdn.microsoft.com/en-us/library/aa432678(v=office.12).aspx 248 | If ISObject(Shape.TextEffect) Then 249 | 250 | Dim xlColumnNum, Cell, CellVarType 251 | 252 | xlColumnNum = dictMapping(Shape.Name) 253 | Cell = xlTargetSheet.Cells(xlRowNum, xlColumnNum) 254 | CellVarType = VarType(Cell) 255 | 256 | IF CellVarType = 0 Or _ 257 | CellVarType = 5 Or _ 258 | CellVarType = 8 Or _ 259 | CellVarType = 17 Then 260 | 261 | ' and update Data 262 | Shape.TextEffect.Text = xlTargetSheet.Cells(xlRowNum, dictMapping(Shape.Name)) 263 | 264 | Else 265 | WScript.Echo("Warning: Incompatible cell type '" & CellVarType & "' in Cell (" & xlRowNum & "," & xlColumnNum & ")!") 266 | End If 267 | Else 268 | WScript.Echo("Warning: Incompatible shape type (" & Shape.Type & ") for data binding '" & Shape.Name & "'!") 269 | End If 270 | 271 | End IF 272 | 273 | Next 274 | 275 | dictUpdated(TargetId) = true 276 | 277 | pb.NextStep() 278 | 279 | Next 280 | 281 | ' Check for missing links 282 | For Each Key in dictUpdated.Keys 283 | 284 | If Not dictUpdated(Key) Then 285 | WScript.Echo("Warning: ID " & Key & " on Slide " & dictSlideIndex(Key) & " not found in data source!") 286 | End If 287 | Next 288 | 289 | success = true 290 | 291 | Exit Do 292 | Loop 293 | 294 | pb.Close() 295 | 296 | If Not xlApp Is Nothing Then xlApp.Quit 297 | If success Then WScript.Echo("Finished") 298 | 299 | 300 | Set xlBook = Nothing 301 | Set xlApp = Nothing 302 | 303 | Set ppPpt = Nothing 304 | Set ppApp = Nothing 305 | 306 | WScript.Quit 307 | 308 | 309 | ' 310 | ' WriteUTF8WithoutBOM 311 | ' 312 | ' http://stackoverflow.com/questions/4143524/can-i-export-excel-data-with-utf-8-without-bom 313 | ' 314 | Function WriteUTF8WithoutBOM(outText, outFile) 315 | 316 | Dim UTFStream 317 | Set UTFStream = CreateObject("adodb.stream") 318 | UTFStream.Type = 2 'adTypeText 319 | UTFStream.Mode = 3 'adModeReadWrite 320 | UTFStream.Charset = "UTF-8" 321 | UTFStream.Open 322 | UTFStream.WriteText outText 323 | 324 | UTFStream.Position = 3 'skip BOM 325 | 326 | Dim BinaryStream 327 | Set BinaryStream = CreateObject("adodb.stream") 328 | BinaryStream.Type = 1 'adTypeBinary 329 | BinaryStream.Mode = 3 'adModeReadWrite 330 | BinaryStream.Open 331 | 332 | 'Strips BOM (first 3 bytes) 333 | UTFStream.CopyTo BinaryStream 334 | 335 | UTFStream.Flush 336 | UTFStream.Close 337 | 338 | BinaryStream.SaveToFile outFile, 2 'adSaveCreateOverWrite 339 | BinaryStream.Flush 340 | BinaryStream.Close 341 | 342 | End Function 343 | 344 | ' 345 | ' xlGetTargetSheet 346 | ' 347 | ' Return reference of target sheet by name or first sheet 348 | ' 349 | Function xlGetTargetSheet(Book, TargetSheetName) 350 | 351 | Dim TargetSheet 352 | 353 | If TargetSheetName = "" Then 354 | Set TargetSheet = Book.Sheets(1) 355 | Else 356 | For Each Sheet in Book.Sheets 357 | If Sheet.Name = TargetSheetName Then 358 | Set TargetSheet = Sheet 359 | Exit For 360 | End If 361 | Next 362 | End If 363 | 364 | If TargetSheet Is Nothing Then 365 | WScript.Echo "Error: Sheet '" & TargetSheetName & "' not found!" 366 | End If 367 | 368 | Set xlGetTargetSheet = TargetSheet 369 | 370 | End Function 371 | 372 | ' 373 | ' xlGetHeaderRow 374 | ' 375 | ' Return number of first non-empty row in TargetSheet and asume it's the table header 376 | ' 377 | Function xlGetHeaderRow(TargetSheet, FirstCol) 378 | 379 | Dim RowNum, targetCells 380 | 381 | RowNum = 1 382 | 383 | targetCells = TargetSheet.Cells(RowNum, FirstCol) 384 | 385 | Do While TargetSheet.Cells(RowNum, FirstCol).Value = "" 386 | RowNum = RowNum + 1 387 | If RowNum > 100 Then Exit Do 388 | Loop 389 | 390 | If RowNum > 100 Then 391 | xlGetHeaderRow = "" 392 | Else 393 | xlGetHeaderRow = RowNum 394 | End If 395 | 396 | End Function 397 | 398 | ' 399 | ' xlGetMapping 400 | ' 401 | ' Return a dictonary which maps headings to column numbers 402 | ' 403 | Function xlGetMapping(TargetSheet, HeaderRow, FirstCol) 404 | 405 | Dim Mapping, ColNum 406 | 407 | Set Mapping = CreateObject("Scripting.Dictionary") 408 | ColNum = FirstCol 409 | 410 | Do 411 | Dim Value 412 | 413 | ' Get cell value 414 | Value = CStr(TargetSheet.Cells(HeaderRow, ColNum).Value) 415 | 416 | ' Loop until cell is empty 417 | If Value = "" Then 418 | Exit Do 419 | End If 420 | 421 | ' Check for duplicated keys 422 | If Mapping.Exists("{{" & Value & "}}") Then 423 | 424 | Dim numCopy, newName 425 | 426 | numCopy = 1 427 | 428 | ' Rename until key is unique 429 | Do 430 | newName = Value & "_" & numCopy 431 | 432 | If Not Mapping.Exists("{{" & newName & "}}") Then 433 | Exit Do 434 | End If 435 | 436 | numCopy = numCopy + 1 437 | Loop 438 | 439 | WScript.Echo("Warning: Mapping dublicated heading on column " & ColNum & " to '" & newName & "'.") 440 | 441 | Value = newName 442 | End If 443 | 444 | ' Add heading->column 445 | Mapping.Add "{{" & Value & "}}", ColNum 446 | 447 | ColNum = ColNum + 1 448 | Loop 449 | 450 | Set xlGetMapping = Mapping 451 | 452 | If ColNum = FirstCol Then 453 | WScript.Echo "Error: No headings found!" 454 | Set xlGetMapping = Nothing 455 | End If 456 | 457 | End Function 458 | 459 | ' 460 | ' xlGetCommon 461 | ' 462 | ' Return a dictonary whith common information 463 | ' 464 | Function xlGetCommon(Book) 465 | 466 | Dim dictCommon 467 | 468 | Set dictCommon = CreateObject("Scripting.Dictionary") 469 | 470 | dictCommon.Add "{source}", Book.Name 471 | 472 | Set xlGetCommon = dictCommon 473 | 474 | End Function 475 | 476 | Function xlGetIDs(TargetSheet, FirstDataRow, FirstCol) 477 | 478 | Dim dictIDs, RowNum, errDoublicatedId, TargetID 479 | 480 | Set dictIDs = CreateObject("Scripting.Dictionary") 481 | RowNum = FirstDataRow 482 | errDoublicatedId = false 483 | 484 | Do 485 | TargetID = CStr(TargetSheet.Cells(RowNum, FirstCol).Value) 486 | 487 | If TargetID = "" Then 488 | Exit Do 489 | End If 490 | 491 | If dictIDs.Exists(TargetID) Then 492 | errDoublicatedId = true 493 | Exit Do 494 | End If 495 | 496 | dictIDs.Add TargetID, RowNum 497 | 498 | RowNum = RowNum + 1 499 | Loop 500 | 501 | Set xlGetIDs = dictIDs 502 | 503 | If RowNum = 1 Then 504 | WScript.Echo "Error: No data found!" 505 | Set xlGetIDs = Nothing 506 | End If 507 | 508 | If errDoublicatedId Then 509 | WScript.Echo "Error: Dublicated ID '" & TargetID & "' in Row '" & RowNum & "'!" 510 | Set xlGetIDs = Nothing 511 | End If 512 | 513 | End Function 514 | 515 | Function isConsoleScript() 516 | If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then 517 | isConsoleScript = True 518 | Else 519 | isConsoleScript = False 520 | End If 521 | End Function 522 | 523 | ' 524 | ' UserInput 525 | ' 526 | ' Return input from user or default valie 527 | ' 528 | Function UserInput(PromptText, Title, DefaultValue) 529 | ' This function prompts the user for some input. 530 | ' When the script runs in CSCRIPT.EXE, StdIn is used, 531 | ' otherwise the VBScript InputBox( ) function is used. 532 | ' myPrompt is the the text used to prompt the user for input. 533 | ' The function returns the input typed either on StdIn or in InputBox( ). 534 | ' Written by Rob van der Woude 535 | ' http://www.robvanderwoude.com 536 | 537 | If isConsoleScript() Then 538 | Dim DefaultText 539 | 540 | If DefaultValue <> "" Then 541 | DefaultText = " [" & DefaultValue & "]" 542 | Else 543 | DefaultText = "" 544 | End If 545 | 546 | WScript.StdOut.Write PromptText & DefaultText & ": " 547 | UserInput = WScript.StdIn.ReadLine 548 | 549 | If UserInput = "" Then 550 | UserInput = DefaultValue 551 | End If 552 | Else 553 | ' If not, use InputBox( ) 554 | UserInput = InputBox(PromptText, Title, DefaultValue) 555 | End If 556 | End Function 557 | 558 | ' 559 | ' SelectFileDialog 560 | ' 561 | ' Return file name from file-open dialog 562 | ' 563 | Function SelectFileDialog() 564 | ' File Browser via HTA 565 | ' Author: Rudi Degrande, modifications by Denis St-Pierre and Rob van der Woude 566 | ' Features: Works in Windows Vista and up (Should also work in XP). 567 | ' Fairly fast. 568 | ' All native code/controls (No 3rd party DLL/ XP DLL). 569 | ' Caveats: Cannot define default starting folder. 570 | ' Uses last folder used with MSHTA.EXE stored in Binary in [HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32]. 571 | ' Dialog title says "Choose file to upload". 572 | ' Source: https://social.technet.microsoft.com/Forums/scriptcenter/en-US/a3b358e8-15ae-4ba3-bca5-ec349df65ef6/windows7-vbscript-open-file-dialog-box-fakepath?forum=ITCG 573 | 574 | SelectFileDialog = "" 575 | 576 | If ConsoleMode And isConsoleScript() Then 577 | WScript.StdOut.Write "Select File: " 578 | SelectFileDialog = WScript.StdIn.ReadLine 579 | Else 580 | 581 | Dim objExec, strMSHTA, wshShell 582 | 583 | 584 | ' For use in HTAs as well as "plain" VBScript: 585 | strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _ 586 | & "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _ 587 | & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>""" 588 | ' For use in "plain" VBScript only: 589 | ' strMSHTA = "mshta.exe ""about:" _ 590 | ' & """" 592 | 593 | Set wshShell = CreateObject( "WScript.Shell" ) 594 | Set objExec = wshShell.Exec( strMSHTA ) 595 | 596 | SelectFileDialog = objExec.StdOut.ReadLine( ) 597 | 598 | Set objExec = Nothing 599 | Set wshShell = Nothing 600 | 601 | End If 602 | 603 | End Function 604 | 605 | ' 606 | ' YesNoDialog 607 | ' 608 | ' Return user response yes or no 609 | ' 610 | Function YesNoDialog(PromptText, Title) 611 | 612 | YesNoDialog = "" 613 | 614 | If ConsoleMode And isConsoleScript() Then 615 | WScript.StdOut.Write PromptText & "[y/n]: " 616 | YesNoDialog = LCase(WScript.StdIn.ReadLine) 617 | Else 618 | result = MsgBox (PromptText, vbYesNo, Title) 619 | 620 | Select Case result 621 | Case vbYes 622 | YesNoDialog = "y" 623 | Case vbNo 624 | YesNoDialog = "n" 625 | End Select 626 | 627 | End If 628 | End Function 629 | 630 | ' 631 | ' getFullPath 632 | ' 633 | ' Return full path if files exists 634 | ' 635 | Function GetFullPath(FileName) 636 | 637 | Dim fso 638 | 639 | Set fso = CreateObject("Scripting.FileSystemObject") 640 | 641 | If (fso.FileExists(FileName)) Then 642 | GetFullPath = fso.GetAbsolutePathName(FileName) 643 | Else 644 | GetFullPath = "" 645 | End If 646 | End Function 647 | 648 | ' 649 | ' SelectFile 650 | ' 651 | ' Return full path of target file or empty string on error 652 | ' 653 | Function SelectFile(PromptText) 654 | 655 | Dim FileName 656 | 657 | If PromptText <> "" Then 658 | WScript.Echo PromptText 659 | End If 660 | 661 | FileName = SelectFileDialog() 662 | 663 | If FileName = "" Then 664 | WScript.Echo "Error: No file selected!" 665 | Else 666 | FileName = GetFullPath(FileName) 667 | 668 | If FileName = "" Then 669 | WScript.Echo "Error: File '" & FileName & "' does not exist!" 670 | End If 671 | End If 672 | 673 | SelectFile = FileName 674 | 675 | End Function 676 | 677 | ' 678 | ' ppGetShapes 679 | ' 680 | ' Return dictonary with all shapes including nested shapes 681 | ' 682 | Function ppGetShapes(Shapes) 683 | 684 | Set dictShapes = CreateObject("Scripting.Dictionary") 685 | Set dictShapes = ppGetShapesRecursive(dictShapes, Shapes) 686 | Set ppGetShapes = dictShapes 687 | 688 | End Function 689 | 690 | ' 691 | ' ppGetShapes 692 | ' 693 | ' Return dictonary with all shapes including nested shapes (recursive) 694 | ' 695 | Function ppGetShapesRecursive(Data, Shapes) 696 | 697 | For Each Shape in Shapes 698 | 699 | ' If shape is group element 700 | If Shape.Type = 6 Then ' msoGroup 701 | Set Data = ppGetShapesRecursive(Data, Shape.GroupItems) 702 | Else 703 | 704 | ' Check for data bindings 705 | If Left(Shape.Name, 1) = "{" And Right(Shape.Name, 1) = "}" Then 706 | Data.Add Data.Count + 1, Shape 707 | End If 708 | 709 | End If 710 | 711 | Next 712 | 713 | Set ppGetShapesRecursive = Data 714 | 715 | End Function 716 | 717 | ' 718 | ' ProgressBar 719 | ' 720 | ' Source: http://www.northatlantawebdesign.com/index.php/2009/07/16/simple-vbscript-progress-bar/ 721 | ' 722 | Class ProgressBar 723 | Private m_PercentComplete 724 | Private m_CurrentStep 725 | Private m_ProgressBar 726 | Private m_Total 727 | Private m_Count 728 | Private m_Title 729 | Private m_Text 730 | Private m_StatusBarText 731 | 732 | 'Initialize defaults 733 | Private Sub ProgessBar_Initialize 734 | Set m_ProgressBar = Nothing 735 | m_PercentComplete = 0 736 | m_CurrentStep = 0 737 | m_Title = "Progress" 738 | m_Text = "" 739 | End Sub 740 | 741 | Public Function SetTitle(pTitle) 742 | m_Title = pTitle 743 | End Function 744 | 745 | Public Function SetText(pText) 746 | m_Text = pText 747 | End Function 748 | 749 | Public Function Update(percentComplete) 750 | m_PercentComplete = percentComplete 751 | UpdateProgressBar() 752 | End Function 753 | 754 | Public Function Show() 755 | Set m_ProgressBar = CreateObject("InternetExplorer.Application") 756 | 'in code, the colon acts as a line feed 757 | m_ProgressBar.navigate2 "about:blank" : m_ProgressBar.width = 315 : m_ProgressBar.height = 40 : m_ProgressBar.toolbar = false : m_ProgressBar.menubar = false : m_ProgressBar.statusbar = false : m_ProgressBar.visible = True 758 | m_ProgressBar.document.write "
0
" 759 | m_ProgressBar.document.write "
" 760 | m_ProgressBar.document.write "
" 761 | End Function 762 | 763 | Public Function NextTaks(pTitle, pText, pbTotal) 764 | 765 | SetTitle(pTitle) 766 | SetText(pText) 767 | 768 | m_Total = pbTotal 769 | m_Count = pbCount 770 | m_PercentComplete = 0 771 | 772 | UpdateProgressBarStep() 773 | End Function 774 | 775 | Public Function NextStep() 776 | m_Count = m_Count + 1 777 | UpdateProgressBarStep() 778 | End Function 779 | 780 | Public Function Close() 781 | If ISObject(m_ProgressBar) Then 782 | m_ProgressBar.quit 783 | Set m_ProgressBar = Nothing 784 | End If 785 | End Function 786 | 787 | Private Function UpdateProgressBar() 788 | If m_PercentComplete = 0 Then 789 | m_StatusBarText = "" 790 | End If 791 | For n = m_CurrentStep to m_PercentComplete - 1 792 | m_StatusBarText = m_StatusBarText & "|" 793 | m_ProgressBar.Document.GetElementById("statusbar").InnerHtml = m_StatusBarText 794 | m_ProgressBar.Document.title = n & "% Complete : " & m_Title 795 | m_ProgressBar.Document.GetElementById("pc").InnerHtml = n & "% Complete : " & m_Title 796 | wscript.sleep 10 797 | Next 798 | m_ProgressBar.Document.GetElementById("statusbar").InnerHtml = m_StatusBarText 799 | m_ProgressBar.Document.title = m_PercentComplete & "% Complete : " & m_Title 800 | m_ProgressBar.Document.GetElementById("pc").InnerHtml = m_PercentComplete & "% Complete : " & m_Title 801 | m_ProgressBar.Document.GetElementById("text").InnerHtml = m_Text 802 | m_CurrentStep = m_PercentComplete 803 | End Function 804 | 805 | 806 | Private Function UpdateProgressBarStep() 807 | 808 | m_PercentComplete = Int((m_Count/m_Total)*100) 809 | 810 | If m_PercentComplete = 0 Then 811 | m_StatusBarText = "" 812 | End If 813 | 814 | For n = m_CurrentStep to m_PercentComplete - 1 815 | m_StatusBarText = m_StatusBarText & "|" 816 | m_ProgressBar.Document.GetElementById("statusbar").InnerHtml = m_StatusBarText 817 | m_ProgressBar.Document.title = n & "% Complete : " & m_Title 818 | m_ProgressBar.Document.GetElementById("pc").InnerHtml = "Step " & m_Count & " of " & m_Total & " : " & m_Title 819 | wscript.sleep 10 820 | Next 821 | 822 | m_ProgressBar.Document.GetElementById("statusbar").InnerHtml = m_StatusBarText 823 | m_ProgressBar.Document.title = n & "% Complete : " & m_Title 824 | m_ProgressBar.Document.GetElementById("pc").InnerHtml = "Step " & m_Count & " of " & m_Total & " : " & m_Title 825 | m_ProgressBar.Document.GetElementById("text").InnerHtml = m_Text 826 | m_CurrentStep = m_PercentComplete 827 | End Function 828 | 829 | End Class 830 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Peter Postmann 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Presentation.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/peterpostmann/Excel-to-Powerpoint-bridge/c22281a301a52ea826db47ce032c87c7c2ae8fa6/Presentation.pptx -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Excel-to-Powerpoint-bridge 2 | Generate Powerpoint slides from Excel data. Each row results in a slide in the presentation. 3 | --------------------------------------------------------------------------------