sVerweis in VBA in PP auf Datein in Excel Datei

Hallo ihr lieben,
ich verzweifel gerade ein bisschen. Ich habe von VBA nur Grundkenntnisse und versuche seit Tagen folgendes:
Ich habe eine dynamische Excel Datei, in der laufend neue Daten eingetragen werden: neue Mitarbeiter mit Funktion, Geburtsdatum etc.
Zusätzlich habe ich eine PowerPoint Folie gebaut, in der entsprechende Textfelder sind. Ich möchte nun, dass wenn in der PowerPoint Folie der Name des Mitarbeiters eingetragen wird, alle anderen Daten per sVerweis aus der Excel Datei gezogen werden.
Dazu habe ich mir folgendes überlegt, was jedoch nicht funktionieren will (Es kommt immer der Laufzeitfehler 1004):
Sub vba_sverweis()
Dim wb As Workbook, wks As Worksheet
Dim Folie As Slide, Textfeld As Shape
Set wb = Workbooks.Open(FileName:="C:\MA\Watchlist_DUMMY.xlsx", ReadOnly:=True)
Set wks = wb.Worksheets("Mitarbeiter Stand 01.01.2017")
Set Folie = ActivePresentation.Slides(1)
Set Textfeld = Folie.Shapes("Text Placeholder 6")
Textfeld.TextFrame.TextRange.Text = WorksheetFunction.VLookup(Folie.Shapes("Text Placeholder 8"), wks.Range("$E:$G"), 2, False).Text
End Sub
Die "Test Placeholder X" stimmen so, das sind die Textfelder, in die die Daten sollen bzw. das Textfeld, in dem der Name des Mitarbeiters steht; das habe ich mir mit folgendem Makro auslesen lassen:

Public Sub Namenfinden()
MsgBox ActiveWindow.Selection.ShapeRange.Name
End Sub

Ich hoffe ihr könnt mir helfen, vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Niklas,
wie bereits von mmat geschrieben muss du im PowerPoint-Makro erst die Excel-Umgebung kreieren/aufrufen bevor du per VBA in Excel Objekte bearbeiten kannst.
Für die Suche nach Einträgen und das Auslesen von Daten ist die Funktion "Match" unter VBA einfacher zu handhaben als "vLookup"-insbesondere was die Behandlung von Fehlern angeht, wenn der Suchbegriff nicht vorhanden ist.
LG
Franz

'Bearbeitet unter PowerPoint 2010 - MS Office Professional 2010
Sub vba_sverweis()
Dim objAppExcel As Object ' Excel.Application
Dim wb As Object ' Excel.Workbook
Dim wks As Object 'Excel.Worksheet
Dim Folie As Slide, Textfeld As Shape
Dim varZeile, varWert As Variant, varSuch As Variant
Dim bolExcelOpen As Boolean
Dim strFile_xl As String, strSheet_xl As String
Dim strMsgTitel As String
On Error GoTo Fehler
strFile_xl = "C:\MA\Watchlist_DUMMY.xlsx"
strSheet_xl = "Mitarbeiter Stand 01.01.2017"
strMsgTitel = "Excel-Daten holen" 'Titel-Zeile für Msgbox-Anzeigen
'Excel-Anwendung zuweisen - bei Fehler Excel starten
bolExcelOpen = True
'auf bereits geöffnete Ecxel-Anwendung zugreifen
Set objAppExcel = VBA.GetObject(, "Excel.Application")
'Datei-Öffnen und Blatt festlegen
Set wb = objAppExcel.Workbooks.Open(FileName:=strFile_xl, ReadOnly:=True)
Set wks = wb.Worksheets(strSheet_xl) 'ggf. Index-Nr. 1 statt Blattname verwenden
Set Folie = ActivePresentation.Slides(1)
'Suchbegriff einlesen
varSuch = Folie.Shapes("Text Placeholder 8").TextFrame.TextRange.Text
'Zeile mit Suchbegriff in Spalte E des Tabellenblatts suchen
varZeile = objAppExcel.Match(varSuch, wks.Range("E:E"), 0)
If IsError(varZeile) Then
MsgBox "Name """ & varSuch & """ nicht gefunden!", vbOKOnly, strMsgTitel
Else
'Werte aus Exceltabellenblatt einlesen und in den Texfeldern der Folie eintragen
varWert = wks.Cells(varZeile, 6).Text 'Wert aus Spalte F
Set Textfeld = Folie.Shapes("Text Placeholder 6")
Textfeld.TextFrame.TextRange.Text = varWert
varWert = wks.Cells(varZeile, 7).Text'Wert aus Spalte G
Folie.Shapes("Text Placeholder 7").TextFrame.TextRange.Text = varWert
'....usw.
End If
'Exceldatei schliessen und ggf. die Excelanwendung beenden
wb.Close savechanges:=False
If bolExcelOpen = False Then
objAppExcel.Quit
End If
Set wks = Nothing
Set wb = Nothing
Set objAppExcel = Nothing
'Fehlerbhandlung
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 9 'Element fehlt in Liste
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Blatt """ & strSheet_xl & """ nicht in Excel-Datei vorhanden", _
vbOKOnly + vbCritical, strMsgTitel
Case 429 'Active-X-Objekt-Erstellung nicht möglich (Excel ist noch nicht gestartet)
Set objAppExcel = VBA.CreateObject("Excel.Application")
bolExcelOpen = False
objAppExcel.Visible = True 'ggf. auf False ändern wenn alles funktioniert
Resume Next
Case 1004 'Element fehlt in Liste
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly + vbCritical, strMsgTitel
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly + vbCritical, strMsgTitel
End Select
End With
If Not objAppExcel Is Nothing Then
If Not wb Is Nothing Then
wb.Close savechanges:=False
End If
If objAppExcel.Visible = False Then
objAppExcel.Quit
End If
End If
End Sub

Beliebteste Forumthreads (12 Monate)

sVerweis in VBA in PP auf Datein in Excel Datei

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

sVerweis in VBA in PP auf Datein in Excel Datei

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

321 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread