Über Button Bild oder Pdf einfügen

Private Sub CommandButton2_Click() Range("F2").Select PicLocation = Application.GetOpenFilename("Image Files (*.jpg; *.png; *.bmp; *.gif),*.jpg; *. _ png, *.bmp, *.gif", , "Select Image File", , "False") On Error GoTo fehler ActiveSheet.Shapes.AddPicture(PicLocation, False, True, -1, -1, -1, -1).Select With Selection.ShapeRange ' Align picture to top left of range .LockAspectRatio = msoFalse .Top = ActiveCell.Top .Left = ActiveCell.Left .Height = ActiveCell.Height .Width = ActiveCell.Width End With fehler: End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lars,
hier 2 Beispiele, wie du deine Prozedur für Bilder etwas allgemeiner gestalten kannst (auch in verbundene Zellen einfügen)
und wie du eine PDF-Datei einfügen kannst. Bei mehrseitigen PDF-Dateien wird allerdings immer nur Seite 1 angezeigt. Die weiteren Seiten werden erst nach angezeigt, wenn man die Datei nach Doppelklick im PDF-Editor anzeigt. Bei einer PDF-Datei sollte man diese aber nicht verzerren. Ich hab die Prozedur so erstellt, dass die PDF-Datei mit max. Größe eingefügt wird.
Ich hatte ein kleines Problem. Erst nachdem ich im Datei-Explorer die Anwendung zur Anzeige von PDF neu festgelegt hatte auf den Adobe-Reader funktionierte die Anzeige in Excel.
LG
Franz


'Einfügen einer PDF-Datei
Private Sub CommandButton1_Click()
Dim varPDF As Variant
Dim objOLE As OLEObject
Dim rngObject As Range
On Error GoTo fehler
With Range("B4")
.Select
If .MergeCells = True Then
Set rngObject = .MergeArea
Else
Set rngObject = .Cells
End If
End With
varPDF = Application.GetOpenFilename("PDF (*.pdf),*.pdf", , "Select PDF File", , "False")
If varPDF = False Then Exit Sub
Set objOLE = ActiveSheet.OLEObjects.Add(Filename:=varPDF, _
Link:=False, DisplayAsIcon:=False)
With objOLE
.Top = rngObject.Top
.Left = rngObject.Left
If .Width > rngObject.Width Then .Width = rngObject.Width
If .Height > rngObject.Height Then .Height = rngObject.Height
End With
fehler:
End Sub


'einfügen eines Bildes
Private Sub CommandButton2_Click()
Dim PicLocation As Variant
Dim objShape As Shape
Dim rngObject As Range
On Error GoTo fehler
With Range("F2")
.Select
If .MergeCells = True Then
Set rngObject = .MergeArea
Else
Set rngObject = .Cells
End If
End With
PicLocation = Application.GetOpenFilename("Image Files (*.jpg; *.png; *.bmp; *.gif)," _
& "*.jpg; *.png; *.bmp; *.gif", , "Select Image File", , "False")
If PicLocation = False Then Exit Sub
Set objShape = ActiveSheet.Shapes.AddPicture(PicLocation, msoFalse, msoTrue, _
rngObject.Left, rngObject.Top, rngObject.Width, rngObject.Height)
fehler:
End Sub

Beliebteste Forumthreads (12 Monate)

Über Button Bild oder Pdf einfügen

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

109 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Über Button Bild oder Pdf einfügen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

109 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread