Office - Word, Excel und Co. 9.741 Themen, 41.378 Beiträge

In Powerpoint per VBA excel/access öffnen ? Geht das???

Moeppi / 5 Antworten / Flachansicht Nickles

Hallo Zusammen,
ich habe sehr umfangreiche Powerpoint Presentationen und möchte diese in mehrere Sprachen umsetzen aber dies ohne "copy & paste". Deswegen: kann ich Text aus einer externen Quelle (Excel/ Access) in Powerpoint per VBA einlesen??? Bin für jeden Hinweis/Tipp sehr dankbar.

Many Many Thankx in advance
moeppi

bei Antwort benachrichtigen
Uli M Moeppi „Hallo Uli M, Ist das in etwa so? Ja, genau so. Ich will quasi in der Tabelle die...“
Optionen

Hab ein wenig in PP gestöbert und mal einen weiter gehenden Ansatz geschrieben (sollte letztlich wohl besser nicht in der richtigen PP sitzen, sondern bel. andere, damit nicht Makros mit dabei sind. In diesem Fall die richtige vor Ablauf aktivieren):
Sub Übersetzen()
Const ksMappe = "U:\\Test\\PP-Texte.xls"
Const kiBlatt = 1 ' Index
Const kiOri = 1 ' Index der Spalte mit dem Originaltexten
Const kiNeu = 2 ' Index der Spalte mit der jeweils anderen Sprache
Dim aTexte() As String
Dim Y As Long, yMax As Long

' PP:
Dim objSlide As Slide
Dim objShape As Shape
Dim L As Long, N As Long
Dim sText As String

Dim objExcel As Object
Dim objMappe As Object
Dim objBlatt As Object
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
Set objMappe = objExcel.Workbooks.Open(ksMappe)
Set objBlatt = objMappe.Sheets(kiBlatt)
If Not objBlatt Is Nothing Then
With objBlatt
' Annahme: Zeile 1 = Header
yMax = .Usedrange.Rows.Count
ReDim aTexte(yMax - 2, 1)
For Y = 2 To yMax
aTexte(Y - 2, 0) = .Cells(Y, kiOri)
aTexte(Y - 2, 1) = .Cells(Y, kiNeu)
Next Y
End With
End If
objMappe.Close False
objExcel.Quit
Set objMappe = Nothing
Set objExcel = Nothing

' weiter in PP:
If yMax > 2 Then
For Y = 1 To ActivePresentation.Slides.Count
Set objSlide = ActivePresentation.Slides(Y)
If objSlide.Shapes.Count > 0 Then
For L = 1 To objSlide.Shapes.Count
Set objShape = objSlide.Shapes(L)
sText = ""
sText = objShape.TextFrame.TextRange.Text
If sText "" Then
For N = LBound(aTexte) To UBound(aTexte)
' exakt, ggf. noch mit trim und UCASE "abschwächen"
If aTexte(N, 0) = sText Then
objShape.TextFrame.TextRange.Text = aTexte(N, 1)
Exit For
End If
Next N
End If
Next L
End If
Next Y
End If
End Sub

Einen ähnlichen Ansatz könntest du auch hernehmen, um zumindest die Originalspalten in dem Blatt ex PP schon mal zu füllen.

bei Antwort benachrichtigen