VBA Dateipfad aus Getopenfile zur weiteren Benutz.
29.09.2016 20:21:46
Ben
da ich seit ein paar Stunden nicht weiter komme, versuch ich mal mein GLück in diesem Forum, da es mir schon bei so manchen Schwierigkeiten aus der Patsche geholfen hat.
Ausgangssituation
Ich habe via VBA eine Maske gebaut die zur Aufnahme neuer Ideen dient. Aus dieser Maske sollen Daten einmal in eine andere ExcelTabelle überführt werden.
Zum anderen sollen de Daten aus der maske parallel dazu in eine PowerpointDatei überführt werden, welche als ein Onepager fungiert.
Ziel:
Ziel ist es, wenn Leute Ideen haben, sie einfach nur die Maske öffnen müssen, ihre Daten dort eingeben müssen.Nach einem Knopfdruck wird automatisch die Datenbank aktualisiert und dazu eine PowerPoint-Folie erstellt um diese in Gruppenrunden vorszustellen und diskutieren zu können.
Fortschritt:
Der Übertrag in die andere Excel Datei klappt wunderbar sowie auch der Übertrag der Textfelder in die gewünschten Shapes der Powerpoint Folie. Abspeichern klappt auch unter dem heutigen Datum und dem gewünschten Namen.
Mein Problem:
Auf der Maske ist ein Anzeigebereich für ein Bild. Per Application.GetOpenFile kann der Anwender sich ein Bild von seinem PC aussuchen, welches auf der Maske im Anzeigebereich eingeblendet wird. Klappt auch.
Dieses Bild soll nun auch in der PowerPointfolie auftauchen. Und da liegt mein Problem.
Meine erste Idee war, dass ich das Bild in dazugehörige Exceltabelle via .tag-Funktion einfügen und anschließend in Powerpoint rüberkopiere.
Dies ist mir allerdings zu statisch, zudem müsste der Anwender wenn er bspw 2 Ideevorschläge hat oder ausversehen ein falsches Bild hochlädt, die Excelmaske für jeden Versuch neustarten.
Mein zweiter Gedanke (an dem ich gerade hänge): Via GetOpenFile sucht sich der Anwender ja ein Bild aus. Diesen Pfad kann ich einfach kopieren und anschließend ein Bild in PowerPoint hochladen, das genau den selben Pfad wie dieses was vorher in der Maske hochgeladen wurde. Jedoch will es einfach nicht funktionieren. Ich habe mir zwischendrinn MsgBox eingebaut, die bestätigen das der Pfad bis unten ankommt. Ich denke aber das der ausgelesene Pfad nicht wirklich ein String ist.
Ich wäre echt dankbar, wenn mir jemand dabei helfen könnte!
Vielen Dank im Voraus!
Anbei der Teil meines Quellcodes:
Option Explicit
Dim pfBild As String
Private Sub bCancel_Click()
Unload Me
End Sub
Private Sub bPicture_Click()
Dim Bild
'Es kann ein Bild mit den Typen *.JPG;*.bmp;*.cur;*.wmf;*.ico geöffnet werden, welches auf _
der Anzeigemaske angezeigt wird.
Bild = Application.GetOpenFilename("Bilddateien (*.JPG;*.bmp;*.cur;*.wmf;*.ico), *.JPG;*. _
bmp;*.cur;*.wmf;*.ico")
If Bild = "" Or Bild = False Then Exit Sub
On Error Resume Next
Template.Image1.Picture = LoadPicture(Bild)
Template.Image1.PictureSizeMode = fmPictureSizeModeZoom
'der Pfad des Bildes wird auf pfBild übertragen welches als String deklariert ist
pfBild = Bild
MsgBox (pfBild)
End Sub
Private Sub bTransfer_Click()
Dim Pfad As String 'Speicherpfad und Ort der Vorlage
Dim Data As String 'Name der Vorlage
Dim PPT As PowerPoint.Application 'Powerpoint öffnen
Dim PPTNEW As Presentation 'Der entstehende Onepager
Dim Picture As Shape
'Festlegung des Pfades und PPT-Vorlage aus dem der Onepager entstehen soll
Pfad = "C:\Users\Ben\Desktop\OnePager_jetzt erst recht\"
Data = "op_vorlage.pptx"
'PowerPoint-Vorlage öffnen + anzeigen
Set PPT = New PowerPoint.Application
PPT.Visible = msoTrue
PPT.Presentations.Open Filename:=Pfad + Data
'setzt PPTNEW als aktuelle PPTX, bedient sich dort Folie 1 und befüllt die vordefinierten _
Felder mit den dazugehörigen aus der Excel-Datei
Set PPTNEW = PPT.ActivePresentation
PPTNEW.Slides(1).Select
PPTNEW.Slides(1).Shapes("Headline").TextFrame.TextRange.Text = tbHeadline.Value
PPTNEW.Slides(1).Shapes("Idea").TextFrame.TextRange.Text = tbIdea.Value
PPTNEW.Slides(1).Shapes("Facts").TextFrame.TextRange.Text = tbFacts.Value
PPTNEW.Slides(1).Shapes("Background").TextFrame.TextRange.Text = tbBackground.Value
PPTNEW.Slides(1).Shapes("Benefits").TextFrame.TextRange.Text = tbBenefits.Value
PPTNEW.Slides(1).Shapes("Picture_text").Delete
PPTNEW.Slides(1).Shapes("Picture").Select
MsgBox pfBild
'Einfügen des Bildes
Picture = PPTNEW.Slides(1).Shapes.AddPicture(pfBild, msoFalse, msoTrue, 1, 1)