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
Office - Word, Excel und Co. 9.741 Themen, 41.378 Beiträge
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.