Grafiken einfügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Grafiken einfügen
von: AndreasS
Geschrieben am: 06.12.2003 13:10:30

Hallo,

habe ein Problem beim einfügen von Grafiken. Gibt es eine Möglichkeit Bilder mit vorgegebener Größe einzufügen. Habe bisher den Makrorekorder benutzt, aber da die Bilder unterschiedlich groß sind, ergeben sich für jedes Bild andere Größen, da bei den aufgezeichneten Makros immer nur ein Bild berücksichtigt wird. Wenn sich die Größe des Bildes ändert, habe ich mein Problem.
Hier mein Code:


Sub GrafikDateienEinfuegen2()
ActiveSheet.Unprotect "xyz"
Application.ScreenUpdating = False
'On Error GoTo fehler
Dim ZuOeffnendeDatei
Dim isGrafik As Boolean, i As Long
On Error Resume Next
Range("E18:H28").Select
ZuOeffnendeDatei = Application.GetOpenFilename( _
, , "Grafikdateien", , True)
With Sheets("Tabelle1")
    For i = 1 To UBound(ZuOeffnendeDatei)
    isGrafik = True
        Select Case LCase(Right$(ZuOeffnendeDatei(i), 3))
            Case "jpg"
            Case "gif"
            Case "bmp"
            Case Else
            isGrafik = False
        End Select
        If isGrafik Then
       
            .Pictures.Insert ZuOeffnendeDatei(i)
            auswahl
            Makro6
            'Selection.ShapeRange.ScaleHeight 0.64, msoFalse, msoScaleFromTopLeft
            'Selection.ShapeRange.ScaleWidth 0.85, msoFalse, msoScaleFromTopLeft
        End If
    Next
End With
'fehler:
'MsgBox "Ein Fehler ist aufgetreten"
Application.ScreenUpdating = True
ActiveSheet.Protect "xyz"
End Sub


Im vorraus Danke für Eure Hilfe!

Gruß

Andreas
Bild


Betrifft: AW: Grafiken einfügen
von: Ramses
Geschrieben am: 06.12.2003 16:28:41

Hallo

das müsste so gehen:


Sub GrafikDateienEinfuegen2()
ActiveSheet.Unprotect "xyz"
Application.ScreenUpdating = False
'On Error GoTo fehler
Dim ZuOeffnendeDatei
Dim isGrafik As Boolean, i As Long
On Error Resume Next
Range("E18:H28").Select
ZuOeffnendeDatei = Application.GetOpenFilename( _
, , "Grafikdateien", , True)
With Sheets("Tabelle1")
    For i = 1 To UBound(ZuOeffnendeDatei)
    isGrafik = True
        Select Case LCase(Right$(ZuOeffnendeDatei(i), 3))
            Case "jpg"
            Case "gif"
            Case "bmp"
            Case Else
            isGrafik = False
        End Select
        If isGrafik Then
            .Pictures.Insert ZuOeffnendeDatei(i)
            '-----------------------
            'Dieser Code scaliert dein Bild
            With Selection
                .Height = 150
                .Width = 150
            End With
            '-----------------------
        End If
    Next
End With
'fehler:
'MsgBox "Ein Fehler ist aufgetreten"
Application.ScreenUpdating = True
ActiveSheet.Protect "xyz"
End Sub 
     Code eingefügt mit Syntaxhighlighter 1.16



Gruss Rainer


Bild


Betrifft: AW: Grafiken einfügen
von: AndreasS
Geschrieben am: 06.12.2003 18:24:56

Hallo Rainer,

vielen Dank für die schnelle Antwort. Es ist ein sehr guter Ansatz. Leider wird immer noch ein riesiges Bild eingefügt. Vielleicht fällt Dir ja noch was ein. Über eine Antwort würde ich mich freuen.

Gruß

Andreas


Bild


Betrifft: So geht es...
von: Ramses
Geschrieben am: 06.12.2003 19:11:58

Hallo

da habe ich vorhin etwas übersehen :-)


Option Explicit

Sub GrafikDateienEinfuegen2()
ActiveSheet.Unprotect "xyz"
Application.ScreenUpdating = False
'On Error GoTo fehler
Dim ZuOeffnendeDatei
Dim isGrafik As Boolean, i As Long
On Error Resume Next
Range("E18:H28").Select
ZuOeffnendeDatei = Application.GetOpenFilename( _
, , "Grafikdateien", , True)
With Sheets("Tabelle1")
    For i = 1 To UBound(ZuOeffnendeDatei)
    isGrafik = True
        Select Case LCase(Right$(ZuOeffnendeDatei(i), 3))
            Case "jpg"
            Case "gif"
            Case "bmp"
            Case Else
            isGrafik = False
        End Select
        If isGrafik Then
            'Das Select gehört noch mit dazu
            'damit das eingefügte Bild gleich selectiert bleibe
            .Pictures.Insert(ZuOeffnendeDatei(i)).Select
            '-----------------------
            'Dieser Code scaliert dein Bild
            With Selection
                'Die Zahlen bitte anpassen
                .Height = 50
                .Width = 50
            End With
            '-----------------------
        End If
    Next
End With
'fehler:
'MsgBox "Ein Fehler ist aufgetreten"
Application.ScreenUpdating = True
ActiveSheet.Protect "xyz"
End Sub 
     Code eingefügt mit Syntaxhighlighter 1.16




Gruss Rainer


Bild


Betrifft: AW: Grafiken einfügen
von: K.Rola
Geschrieben am: 06.12.2003 21:38:13

Hallo,

haben deine Bilder immer das gleiche Seitenverhältnis, oder anders,
sollen sollen sie im richtigen Seitenverhältnis skaliert werden?
Wenn ja, welches Maß ist dann ausschlaggebend, Breite oder Höhe?

Deinem Code nach werden die alle an der selben Stelle eingefügt,
ist das so gewollt?

Wozu ist diese Codezeile: Range("E18:H28").Select ?

Gruß K.Rola


Bild

Beiträge aus den Excel-Beispielen zum Thema " Grafiken einfügen"