Anzeige
Archiv - Navigation
1324to1328
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
Inhaltsverzeichnis

Bild hochformat/querformat

Bild hochformat/querformat
07.08.2013 14:13:12
Albert
Hallo zusammen,
ist es möglich, dass man beim Auswählen/Einfügen eines Bildes automatisch eine Größe vorgeben kann ohne dies manuell machen zu müssen.
Den nachfolgenden Code hab ich zusammengebastelt. Aber so wirklich zufrieden bin ich nicht, da auch die Abbruchbedingung nicht passt.
Private Sub Ok_Click()
Dim rngLocation As Range
Dim i As Integer
Dim shpBild As Shape
Set rngLocation = ActiveCell
Bild = Application.GetOpenFilename("C:\,*.jpg")
If Bild  0 Then
On Error GoTo fehlerbehandlung
ActiveSheet.Pictures.Insert(Bild).Select
'On Error GoTo 0
If FileLen(Bild) / 1024 > 500 Then
MsgBox ("Die Bilddateigröße übersteigt die 500kb Größe! Bitte reduzieren sie erst die  _
Dateigröße! ")
Exit Sub
Else
If querformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then 'nur  _
wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 32
.Left = rngLocation.Left + 8
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9)
End With
For Each shpBild In ActiveSheet.Shapes
If shpBild.Type = msoPicture Then
shpBild.Placement = xlFreeFloating
End If
Next
End If
End If
If hochformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then 'nur  _
wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 10
.Left = rngLocation.Left + 30
.Height = Application.CentimetersToPoints(9)
.Width = Application.CentimetersToPoints(7.25)
End With
For Each shpBild In ActiveSheet.Shapes
If shpBild.Type = msoPicture Then
shpBild.Placement = xlFreeFloating
End If
Next
End If
End If
End If
End If
Exit Sub
fehlerbehandlung:
If Err.Number = 1004 Then MsgBox "Fehler beim Einfügen der Grafik!" _
& Chr(13) & Chr(13) & "Wahrscheinlich kein lesbares Grafikformat"
End Sub
Ich wär euch für Hilfe super dankbar!
Gruß
A.

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

Betreff
Datum
Anwender
Anzeige
AW: Bild hochformat/querformat
07.08.2013 14:29:58
Rudi
Hallo,
das hab ich doch schon mal gesehen...
ist es möglich, dass man beim Auswählen/Einfügen eines Bildes automatisch eine Größe vorgeben kann
was meinst du damit?
Private Sub Ok_Click()
Dim rngLocation As Range
Dim i As Integer
Dim shpBild As Shape, Bild As String
Set rngLocation = ActiveCell
Bild = Application.GetOpenFilename("C:\,*.jpg")
If Bild  0 Then
If FileLen(Bild) / 1024 > 500 Then
MsgBox "Die Bilddateigröße übersteigt die 500kb Größe! Bitte reduzieren sie erst die  _
Dateigröße! "
Exit Sub
End If
On Error GoTo fehlerbehandlung
ActiveSheet.Pictures.Insert(Bild).Select
'On Error GoTo 0
If querformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then
'nur wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 32
.Left = rngLocation.Left + 8
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9)
End With
End If
End If
If hochformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then
'nur wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 10
.Left = rngLocation.Left + 30
.Height = Application.CentimetersToPoints(9)
.Width = Application.CentimetersToPoints(7.25)
End With
End If
End If
For Each shpBild In ActiveSheet.Shapes
If shpBild.Type = msoPicture Then
shpBild.Placement = xlFreeFloating
End If
Next
End If
Exit Sub
fehlerbehandlung:
If Err.Number = 1004 Then MsgBox "Fehler beim Einfügen der Grafik!" _
& Chr(13) & Chr(13) & "Wahrscheinlich kein lesbares Grafikformat"
End Sub
Woher kommen querformat und hochformat?
da .LockAspectRatio=True würde ich entweder die Höhe oder die Breite einstellen.
Gruß
Rudi

Anzeige
AW: Bild hochformat/querformat
07.08.2013 16:00:31
Albert
Servus Rudi,
möglicherweise kommt es daher, dass du hierbei einen großen Teil beigetragen hast. :)
Das hochformat/querformat kommt aus einer Userform, die abgefragt wird.
Zu deiner Frage: Wenn ich ein Bild auswähle, steht ja eigentlich vom fotografieren her schon fest, ob es hoch- oder querformat ist.... Dank ich mal.
Wenn ja, dann könnte man doch dieses Attribut nutzen, um später das hoch-/querformat im Code anzusprechen.
Gruß
A.

AW: Bild hochformat/querformat
07.08.2013 16:42:43
Rudi
Hallo,
steht ja eigentlich vom fotografieren her schon fest
wenn deine Kamera automatisch dreht oder du das von Hand gemacht hast schon.
Püfe doch einfach, ob die Höhe des Bildes größer ist als die Breite.
....
ActiveSheet.Pictures.Insert(Bild).Select
with selection.Shaperange
if .height > .width then
hochformat=true
else
querformat=true
end if
.....

Gruß
Rudi

Anzeige
AW: Bild hochformat/querformat
08.08.2013 07:28:06
Albert
Moin Rudi,
das ist eine sehr gute Idee. Werd deinen Schnipsel gleich einbauen.
Feedback gibts umgehend!
Gruß
A.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige