Bild einfügen mit autom. Größenanpassung

Forumthread: Bild einfügen mit autom. Größenanpassung

21.11.2005 16:50:07

Hoschek

Hallo,
ich bitte um Eure Hilfe. Es ist sicherlich eine fürchterlich einfache Lösung, doch ich kriegs nicht hin und wie so oft wäre es sehr wichtig und eilig...:
Für meine Mitarbeiter habe ich ein Formular, in welches auf einfachste Weise ein Bild eingefügt werden muß. Der Pfad, woher die Bilder kommen, ist variabel.
Die User sollen nur durch einen Klick in eine Pfadauswahl kommen und anschl. soll sich das gewählte Bild in eine vorgegebene Größe (siehe ähnlich eines Positionsrahmens bei Word) einfügen, ohne dass eine Nachbearbeitung erfolgen muß. (Die Bilder haben unterschiedliche Größen und jpg oder bmp.)
Habe hier schon eine erfolgreiche Lösung für das Einfügen von Bildern über Doppelklick bekommen. Jedoch ist nun noch keinerlei Größenformatierung bzw Positionierung erfolgt. Leider habe ich keine VBA-Kenntnisse und nur minimalste Grundlagen in Makros.
Könnt Ihr mir trotzdem helfen?
Folgendes habe ich in das Worksheet eingebaut:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim var As Variant
Dim sFiles As String
sFiles = "Grafikdateien (*.bmp), *.bmp, "
sFiles = sFiles & "Grafikdateien (*.gif), *.gif, "
sFiles = sFiles & "Grafikdateien (*.jpg), *.jpg"
On Error Resume Next
var = Application.GetOpenFilename(sFiles)
ActiveSheet.Pictures.Insert var
End Sub

Vielen Dank!
Karin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild einfügen mit autom. Größenanpassung

21.11.2005 17:19:07

Dan

Hallo Karin, hier ein Vorschlag, wie der Code aussehen koennte. Gruss Dan cz.
Option Explicit


Sub insert_picture()
Dim pic As Picture
Dim path As Variant
Dim sFiles As String
sFiles = "Grafikdateien (*.bmp), *.bmp, "
sFiles = sFiles & "Grafikdateien (*.gif), *.gif, "
sFiles = sFiles & "Grafikdateien (*.jpg), *.jpg"
path = Application.GetOpenFilename(sFiles)
If (path = False) Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(path)
With pic
.Width = 300
.Height = 450
.Top = 150
.Left = 50
End With
End Sub

AW: Bild einfügen mit autom. Größenanpassung

21.11.2005 17:23:50

Josef

Hallo Karin!
Probier mal!

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit
Const maxWidth As Double = 120 'Bildbreite
Const maxHeight As Double = 90 'Bildhöhe

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFile As String, strParam As String
Dim objPic As Picture
Dim rngAnchor As Range

Cancel = True

Set rngAnchor = Target ' oder = Range("B2") 'Zelle als Bezugspunkt zum einfügen!

strParam = "Grafikdateien (*.bmp), *.bmp, "
strParam = strParam & "Grafikdateien (*.gif), *.gif, "
strParam = strParam & "Grafikdateien (*.jpg), *.jpg"

strFile = Application.GetOpenFilename(strParam)

If strFile = "" Then Exit Sub

Set objPic = ActiveSheet.Pictures.Insert(strFile)

With objPic
  .Top = rngAnchor.Top
  .Left = rngAnchor.Left
  With .ShapeRange
    .LockAspectRatio = msoTrue
    If .Width >= .Height Then
      .Width = maxWidth
    Else
      .Height = maxHeight
    End If
  End With
End With

End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Bild einfügen mit autom. Größenanpassung

28.11.2005 17:54:59

Hoschek

Hallo Hans,
irgendwie will es mit der Größe des Bildes einfach nicht klappen.
Kann auch gut sein, dass ich den Code irgendwie falsch einbaue...
Muß das Zielfeld auf eine bestimmte Weise formatiert sein?
Wollte einen Bereich aus Zellen verbinden und das Bild hier einfügen. Oder aber innerhalb eines Rahmens platzieren. Eigentlich ist es egal wie, Hauptsache nicht total verzerrt so wie bisher. Die Bilder sind nicht mehr im richtigen Verhältnis von Breite / Höhe und meist viel zu lang gezerrt.
Mit diesen Begrifflichkeiten wie Modul, Prozedur etc. bin ich leider nicht vertraut *peinlich*. Habe das ganze als neues Makro angelegt (bzw. heißt dann "Modul5(Code)".
Aber wahrscheinlich lieg ich da falsch und es muß anders eingefügt werden?
Das ganze sah bei mir wie folgt aus. Vielen Dank wenn ich nochmal Hilfe bekomme...
Grüsse, Karin
------------------------------------------------------------------
(Allgemein) Bild
-----------------------------------------------------------------
Sub Bild()
'
'Option Explicit
Const maxWidth As Double = 120 'Bildbreite
Const maxHeight As Double = 90 'Bildhöhe
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strFile As String, strParam As String
Dim objPic As Picture
Dim rngAnchor As Range
Cancel = True
Set rngAnchor = Range("G16")
strParam = "Grafikdateien (*.bmp), *.bmp, "
strParam = strParam & "Grafikdateien (*.gif), *.gif, "
strParam = strParam & "Grafikdateien (*.jpg), *.jpg"
strFile = Application.GetOpenFilename(strParam)
If strFile = "" Then Exit Sub
Set objPic = ActiveSheet.Pictures.Insert(strFile)
With objPic
.Top = rngAnchor.Top
.Left = rngAnchor.Left
With .ShapeRange
.LockAspectRatio = msoTrue
If .Width >= .Height Then
.Width = maxWidth
Else
.Height = maxHeight
End If
End With
End With
End Sub

'
End Sub

Beliebteste Forumthreads (12 Monate)

Bild einfügen mit autom. Größenanpassung

Forumthread: Bild einfügen mit autom. Größenanpassung

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bild einfügen mit autom. Größenanpassung

Forumthread: Bild einfügen mit autom. Größenanpassung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread