Hallo Leute, ich arbeite seit neustem mit Makros und stehe jetzt vor einem Problem, welches mir den letzten Nerv raubt. Es geht dabei um PowerPoint und Excel. Folgende Abläufe sollen durch ein Makro ersetzt werden:
In der Spalte A1 steht eine Nummer, unter diesem Namen soll der Inhalt C1:E20 als Bild (Format momentan GIF, prinzipiell egal) abgespeichert werden, und zwar auf dem Pfad C:\
Momentan schaut mein Code so aus:
Nun soll in PowerPoint ein Makro möglich sein, welches mich nach dem Start in einen Dateiöffnungsdialog führt, aus dem ich dann eines der vorher erstellten Bilder auswählen kann, dieses soll dann in PowerPoint eingeladen werden auf die aktuell angewählte Folie und dort in die bestimmte Größe gebracht, horizontal zentrisch und mit dem definierten Abstand nach oben.
Momentan habe ich dazu 3 Makros die allerdings nicht ganz so funktionieren wie ich das gerne hätte.
Die Größe und Position ändere ich nach selektion des Bildes sobald es auf der Folie ist mit:
Der Dateiöffnungsdialog ist leider auch fehlerhaft, denn nach Import wird die Datei nicht auf die Folie gebracht geschweige denn angewählt:
Wenn mir da jemand eine Hilfestellung zu geben könnte wäre das richtig Spitze ! J
In der Spalte A1 steht eine Nummer, unter diesem Namen soll der Inhalt C1:E20 als Bild (Format momentan GIF, prinzipiell egal) abgespeichert werden, und zwar auf dem Pfad C:\
Momentan schaut mein Code so aus:
Quellcode
- Sub Range_To_Image()
- Dim objPict As Object, objChrt As Chart
- Dim rngImage As Range, strFile As String
- On Error GoTo ErrExit
- With Sheets("Tabelle1") 'Tabellenname - Anpassen!
- Set rngImage = .Range("C3:F18")
- rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
- .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
- Set objPict = .Shapes(.Shapes.Count)
- strFile = "C:\1.gif" 'Pfad und Dateiname für das Bild
- objPict.Copy
- Set objChrt = .ChartObjects.Add(1, 1, objPict.Width + 8, objPict.Height + 8).Chart
- objChrt.Paste
- objChrt.Export strFile
- objChrt.Parent.Delete
- objPict.Delete
- End With
- ErrExit:
- Set objPict = Nothing
- Set objChrt = Nothing
- Set rngImage = Nothing
- End Sub
Nun soll in PowerPoint ein Makro möglich sein, welches mich nach dem Start in einen Dateiöffnungsdialog führt, aus dem ich dann eines der vorher erstellten Bilder auswählen kann, dieses soll dann in PowerPoint eingeladen werden auf die aktuell angewählte Folie und dort in die bestimmte Größe gebracht, horizontal zentrisch und mit dem definierten Abstand nach oben.
Momentan habe ich dazu 3 Makros die allerdings nicht ganz so funktionieren wie ich das gerne hätte.
Die Größe und Position ändere ich nach selektion des Bildes sobald es auf der Folie ist mit:
Quellcode
- Sub SizeAndPosition()
- ' Usage: Select two shapes. The size and position of
- ' the first shape selected will be copied to the second.
- Dim w As Double
- Dim h As Double
- Dim l As Double
- Dim t As Double
- With ActiveWindow.Selection.ShapeRange(1)
- .Width = 714.0472440945
- .Height = 466.2992125984
- End With
- With ActivePresentation.PageSetup
- x = .SlideWidth / 2
- End With
- For Each osld In ActivePresentation.Slides
- For Each oshp In osld.Shapes
- If oshp.Type = msoPicture Then
- oshp.Left = x - (oshp.Width / 2)
- oshp.Top = 0.25
- End If
- Next
- Next
- End Sub
Der Dateiöffnungsdialog ist leider auch fehlerhaft, denn nach Import wird die Datei nicht auf die Folie gebracht geschweige denn angewählt:
Quellcode
- Sub Open()
- Dim dlgOpen As FileDialog
- Dim strDatei As String
- Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
- With dlgOpen
- 'nur eine auswählbar True = mehrere Dateien auswählbar
- .AllowMultiSelect = False
- .Show
- On Error Resume Next
- strDatei = .SelectedItems(1)
- If Err <> 0 Then
- MsgBox "Es wurde keine Datei ausgewählt", _
- vbInformation + vbOKOnly, "Titel"
- Else
- MsgBox "Ausgewählte Datei: " & strDatei, _
- vbInformation + vbOKOnly, "Titel"
- End If
- On Error GoTo 0
- End With
- End Sub
Wenn mir da jemand eine Hilfestellung zu geben könnte wäre das richtig Spitze ! J
