AW: Support von ThinkCell
04.07.2016 08:24:58
Dave
Hallo zusammen,
nach mehrmaligen Kontakt mit dem Think-Cell Support ist das Thema als gelöst anzusehen.
Zuerst einmal muss man nur auf drei Sachen achten.
- Deklaration von tcaddin als Object
- Bezug auf das COMAddin von Thinkcell
- Bezug auf PresentationFromTemplate --> in meinem Beispiel wurde eine TESTDATEI auf dem Desktop als MASTER-DATEI angelegt --> wird geöffnet, Daten übertragen Name der Datei im Code "ThinkCell Testdatei_TEST.ppt"
Dim tcaddin As Object
Set tcaddin = Application.COMAddIns("thinkcell.addin").Object
Set pres = tcaddin.PresentationFromTemplate(Excel.ActiveWorkbook, "C:\Users\" & Environ(" _
UserName") & "\Desktop\ThinkCell Testdatei_TEST.ppt", ppapp)
Zur Historie:
- Tabelle in Sheet 1 mit verschiedenen Werten
- Zweite Tabelle inkl. Think-Cell Verknüpfung in Sheet 2
- Vorgefertigte MASTER-Datei welche auf dem Desktop abgespeichert ist
- Alle Dateien werden als .PDF gespeichert
- Speicherort ist ein Ordner auf dem Desktop mit dem Namen "Speicherort Test"
Anbei der vollständige Code
Option Explicit
Sub Test()
'Anbei ein Beispiel mit fiktien Werten
'Daten aus Sheet 1 werden in das Diagramm im Sheet 2 übertragen
'Der Zellenwert in Spalte A dient als Dateiname
'Zwischen den Säulen wird die Differenz berechnet
'Ziel:
'Daten werden übertragen und dabei soll sich Think-Cell innerhalb der Schleife _
aktualisieren und dies dann speichern
'Variablen deklarieren
Dim i, j, k, l As Integer
Dim lrow_1, lcol_1 As Integer
Dim DateiName As String
Dim ppapp As PowerPoint.Application
Set ppapp = New PowerPoint.Application
'Code fuer PresentationFromTemplate
Dim tcaddin As Object
Set tcaddin = Application.COMAddIns("thinkcell.addin").Object
Dim pres As PowerPoint.Presentation
'letzte Zeile und Spalte im Sheete 1 bestimmen
lrow_1 = ActiveWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lcol_1 = ActiveWorkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
'PowerPoint-Datei öffnen
ppapp.Presentations.Open Filename:="C:\Users\" & Environ("UserName") & "\Desktop\ThinkCell _
Testdatei_TEST.ppt"
'Schleife zum Übertrag der Testdaten aus Sheet 1
For i = 4 To lrow_1
For j = 2 To lcol_1
'Schleife der Testdateien aus Sheet 2
For k = 9 To 10
For l = 3 To 11
'Abfrage Säule
If ActiveWorkbook.Sheets(1).Cells(2, j).Value = ActiveWorkbook.Sheets(2). _
Cells(7, l).Value Then
'Abfrage Test
If ActiveWorkbook.Sheets(1).Cells(3, j).Value = ActiveWorkbook.Sheets(2) _
.Cells(k, 2).Value Then
'Übertrag der Daten
ActiveWorkbook.Sheets(2).Cells(k, l).Value = ActiveWorkbook.Sheets(1) _
.Cells(i, j).Value
End If
End If
Next l
Next k
Next j
'Dateiname in Spalte A im Sheet 1 zuweisen, welcher später als Dateiname für die _
PowerPoint-Datei dient
DateiName = ActiveWorkbook.Sheets(1).Cells(i, 1).Value
'Aktualisiere mit PresentationFromTemplate
Set pres = tcaddin.PresentationFromTemplate(Excel.ActiveWorkbook, "C:\Users\" & Environ( _
"UserName") & "\Desktop\ThinkCell Testdatei_Test.ppt", ppapp)
'PowerPoint-Datei speichern: Auf dem Desktop ist ein Ordner "Speicherort Test" angelegt
pres.SaveAs "C:\USERS\" & Environ("UserName") & "\Desktop\Speicherort Test\" & _
DateiName & ".pdf", ppSaveAsPDF
Next i
End Sub
Muss noch anmerken, dass Support von Think-Cell wirklich sehr gut ist und das dort einem geholfen wird.
Wichtig ist: Support ist in der Think-Cell Lizenz enthalten.
Excel-Datei:
https://www.herber.de/bbs/user/106717.xlsm
PowerPoint-Datei
https://www.herber.de/bbs/user/106718.ppt
BITTE BEACHTEN
--> Speicherort ist ein Ordner auf dem Desktop mit dem Namen "Speicherort Test"
--> Think-Cell ist Voraussetzung. Am besten in der aktuellen Version
--> Die beigefügte TESTDATEI ist im Format ppt da ich hier keine pptx hochladen kann
Für die, die es brauchen viel Spaß damit.