Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
348to352
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
348to352
348to352
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Grafiken einfügen

Grafiken einfügen
06.12.2003 13:10:30
AndreasS
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Grafiken einfügen
06.12.2003 16:28:41
Ramses
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
Anzeige
AW: Grafiken einfügen
06.12.2003 18:24:56
AndreasS
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
So geht es...
06.12.2003 19:11:58
Ramses
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
Anzeige
AW: Grafiken einfügen
06.12.2003 21:38:13
K.Rola
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige