Excel Formular Bilder einfügen

echojuergen · 14. November 2019 um 03:06

ich habe ein Excel Formular erstellt und 4 Bereiche(E7:G28)(E31:G52)(E55:G76) und (E79:G100) festgelegt um dort 4 Bilder einzufügen. Die Bilder werden im explorer markiert und dann eingefügt.
Die Bilder werden an der jeweils richtigen Stelle eingefügt sind aber zu lang, das heißt nach unten gehen Sie über die markierung. Desweiteren sollte noch der jeweilige Bildname automatisch in die Zelle D28, D52, D76 und D100 geschrieben werden.
Kann mir jemand helfen den Fehler wegen der Bildlänge zu finden und die Zusatzfunktion einfügen.
Vielen dank, hier mein Code:

Sub BilderEinfuegen()
Dim bytBild As Byte
Dim arrBereiche()
Dim StOrdner As String
Dim SNZelle As String
StOrdner = „d:\Bilder“ & Range(„D5“) & SNZelle
'Der Bereich für die Bilder muss angepasst werden
arrBereiche = Array(„E7:G7“, „E31:G31“, „E55:G55“, „E79:G79“)
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = StOrdner
.ButtonName = „OK“
.Title = „Bilderauswahl“
.Show
If .SelectedItems.Count

Walter_Kunszt · 14. November 2019 um 03:06

Hallo echojuergen,
hierzu kann ich Dir leider keine passende Antwort liefern.
sorry

Gruß

Walter

Helmut_Schuster · 14. November 2019 um 03:06

Hallo, beim codieren kann ich nicht helfen
Bese Grüße
H. Schuster

Giftzwockel · 14. November 2019 um 03:06

Moin,

EXEL verwendet ja Visual Basic.
Wenn die Zellengröße festgelegt ist, hast du nur die Chance, die Bildgröße an die Zellengröße anzupassen.

Unter VB binde ich Bilder in ein PictureBox ein. Dort hat es die PictureBox.Size.Mode Funktion (siehe Code):

Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Me.OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim MyImage As String = Me.OpenFileDialog1.SafeFileName
Me.PictureBox1.Image = Image.FromFile(MyImage)
Me.PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
End If
End Sub
End Class

Ich hoffe, das hilft dir weiter.
Gruß
Stefan

Riedl_Manfred · 14. November 2019 um 03:06

Die Bilder werden an der jeweils richtigen Stelle eingefügt
sind aber zu lang, das heißt nach unten gehen Sie über die
markierung.

Bild zuschneiden siehe hier

Desweiteren sollte noch der jeweilige Bildname
automatisch in die Zelle D28, D52, D76 und D100 geschrieben
werden.

Mit Makrorecorder aufzeichnen.

Waldemar_Wesner · 14. November 2019 um 03:06

hallo echojuergen
so könnte es aussehen

Sub BilderEinfuegen()
Dim bytBild As Byte
Dim arrBereiche()
Dim StOrdner As String
Dim SNZelle As String
 StOrdner = "d:\Bilder\" & Range("D5") & SNZelle
 'Der Bereich für die Bilder muss angepasst werden
**arrBereiche = Array("E7:G30", "E31:G54", "E55:G78", "E79:G102")**
 Application.ScreenUpdating = False
 With Application.FileDialog(msoFileDialogFilePicker)
 .AllowMultiSelect = True
 .InitialFileName = StOrdner
 .ButtonName = "OK"
 .Title = "Bilderauswahl"
 .Show
 If .SelectedItems.Count If .Height \> Range(arrBereiche(bytBild - 1)).Height Then .Height = Range(arrBereiche(bytBild - 1)).Height
 End With
**Range(arrBereiche(bytBild - 1)).Cells(1, 1).Offset(21, -1).Value = Split(.SelectedItems(bytBild), "\")((UBound(Split(.SelectedItems(bytBild), "\"))))**
 Next bytBild
 Else
 MsgBox "Maximal nur 4 Bilder auswählbar"
 End If
 End With
 Application.ScreenUpdating = True
End Sub

MfG.
W.W.

Hugo_a97cd9 · 14. November 2019 um 03:06

Hallo echojuergen,

dabei kann ich leider nicht helfen, dafür reichen meine Kenntnisse nicht.

Gruß Hugo

Sebra7 · 14. November 2019 um 03:06

Den Namen filterst Du z.B. so:

For bytBild = 1 To .SelectedItems.Count
ActiveSheet.Pictures.Insert .SelectedItems(bytBild)
Dim a(0)
Dim x As String
x = .SelectedItems(bytBild)
a(0) = Split(x & „“ , „“)
i = UBound(a(0))
If i 0 Then
RPT:
If (a(0)(i)) = „“ Then
i = i - 1
GoTo RPT
Else
x = a(0)(i)
End If
End If
With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Range(arrBereiche(bytBild - 1)).Top
.Left = Range(arrBereiche(bytBild - 0)).Left
.Width = Range(arrBereiche(bytBild - 1)).Width

Grüsse Sebastian

Ingrid_Kutsche_ed6171 · 14. November 2019 um 03:06

Hallo Jürgen,

tut mir leid, da kann ich nicht helfen.
Falls du hier niemanden findest, versuch es doch mal bei www.office-loesung.de. Da gibts auch eine Gruppe zu VBA: http://www.office-loesung.de/viewforum10_0_0.php

Die super Excel-Newsgroup bei Microsoft gibts ja leider nur noch inoffiziell mit nur noch wenigen Beiträgen (.

Ingrid

ich habe ein Excel Formular erstellt und 4
Bereiche(E7:G28)(E31:G52)(E55:G76) und (E79:G100) festgelegt
um dort 4 Bilder einzufügen. Die Bilder werden im explorer
markiert und dann eingefügt.
Die Bilder werden an der jeweils richtigen Stelle eingefügt
sind aber zu lang, das heißt nach unten gehen Sie über die
markierung. Desweiteren sollte noch der jeweilige Bildname
automatisch in die Zelle D28, D52, D76 und D100 geschrieben
werden.
Kann mir jemand helfen den Fehler wegen der Bildlänge zu
finden und die Zusatzfunktion einfügen.

echojuergen · 14. November 2019 um 03:06

Danke Sebastian,
ich habe jetzt nur das Problem, wie heißt die variable, bzw. unter welcher variablen wird der name abgelegt, und wie lautet der Befehl für die Zelle.
Bin nicht so arg fit.
Gruss Jürgen

Sebra7 · 14. November 2019 um 03:06

Hallo
X ist die Variable. (Mit F8 und dem Fenster Ansicht/Direktfenster kannst Du die Inhalte der Variablen schrittweise beobachten)
tabelle1.cells(2,5)=x wäre dann die Wertzuweisung für die Zelle.
Grüsse Sebastian

Thomas_Ramel · 14. November 2019 um 03:06

Grüezi Jürgen

Die Bilder werden an der jeweils richtigen Stelle eingefügt
sind aber zu lang, das heißt nach unten gehen Sie über die
Markierung.

Füge diesem Code hier noch die Anpassung für die Länge hinzu:

With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Range(arrBereiche(bytBild - 1)).Top
.Left = Range(arrBereiche(bytBild - 0)).Left
.Width = Range(arrBereiche(bytBild - 1)).Width
End With

With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Range(arrBereiche(bytBild - 1)).Top
.Left = Range(arrBereiche(bytBild - 0)).Left
.Width = Range(arrBereiche(bytBild - 1)).Width
.Height = Range(arrBereiche(bytBild - 1)).Height
End With

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

kermit_6ea487 · 14. November 2019 um 03:06

Hallo
Ich kann dir leider nicht weiterhelfen, ich beschäftige mich seit geraumer Zeit nicht mehr mit dieser Materie.

Vermutlich weisen die Bilder und der von dir gewählte (vorgesehene) Bereich verschiedene Größen auf. Die gewählten Bilder sind vermutlich in ihrer Skalierung gesperrt. Bilder entsperren würde eine Verzerrung bedeuten.
Versuchsweise habe ich ähnliches in Excel probiert.
Deinen Bereich mit einem Rahmen versehen
Ein Bild nach Zufall verwendet.
rechte Maustaste: GRÖßE UND EIGENSCHAFTEN
Es öffnet sich ein neues Fenster.

Es finden sich mehrere Parameter mit der Möglichkeit zum Ändern.

Wie im Eingang erwähnt, ist das nicht meine Materie.
lg
kermit

echojuergen · 14. November 2019 um 03:06

Hi Sebastian,
vielen dank für Deine Mühe.
Hab nur noch ein kleines Problem.
Der dateiname wird gedruckt aber an der falschen stelle.
Ich habe vierverschiedene zellen (D28, d52, D76 und D100)
Wie kann ich dies variable zuweisen.
mit range oder aktivsheet …

Vielleicht kannst Du mir noch einaml helfen.
Gruss Jürgen

Sebra7 · 14. November 2019 um 03:06

Ja klar, der Dateiname wird in die Zelle tabelle1.cells(2,5)
2 = Row, 5=Columne
Bei den Columnen oder Spalten zählt folgendes:
A=1; B=2; C=3; D=4; E=5
Der Wert wird also in das Feld E2 geschrieben.
Möchtest Du den Wert in C2 haben, dann wäre der Befehl:
tabelle1.cells(2,3)
Möchtest Du den Eintrag in C50 haben, dann wäre der Code:
tabelle1.cells(50,3)

Grüsse Sebastian

Franz_e6478d · 14. November 2019 um 03:06

hallo Juergen,

mit folgenden Ergänzungen sollte die Bildhöhe angepasst werden, wenn ein Bild zu hoch ist.

Gruß
Franz

Sub BilderEinfuegen()
 Dim bytBild As Byte
 Dim arrBereiche()
 Dim StOrdner As String
 Dim SNZelle As String
 StOrdner = "d:\Bilder\" & Range("D5") & SNZelle
 StOrdner = "C:\Users\Public\" & Range("D5") & SNZelle
 'Der Bereich für die Bilder muss angepasst werden
 arrBereiche = Array("E7:G7", "E31:G31", "E55:G55", "E79:G79")
 Application.ScreenUpdating = False
 With Application.FileDialog(msoFileDialogFilePicker)
 .AllowMultiSelect = True
 .InitialFileName = StOrdner
 .ButtonName = "OK"
 .Title = "Bilderauswahl"
 .Show
 If .SelectedItems.Count Range(arrBereiche(bytBild - 1)).Height Then
 .Height = Range(arrBereiche(bytBild - 1)).Height
 End If
 End With
 Next bytBild
 Else
 MsgBox "Maximal nur 4 Bilder auswählbar"
 End If
 End With
 Application.ScreenUpdating = True
End Sub

Roland_b28fb7 · 14. November 2019 um 03:06

Hallo,

zum bilder einfügen bzw. größe ändern könnte dir das vieleicht weiter helfen.

In Tabelle1 A1 steht der Bildpfad.

Bild wird eingefügt
Name wird geändert in bi1
höhe auf 160 festgelegt
ggf. breite verkleinert (kann eventuell prozentual zur höhe berechnet werden)
Bild weit nach links rücken
Bild weit nach oben rücken
Bild positionieren von links
Bild positionieren von oben

Sub test()
Dim Picture As Picture
Dim s As String

s = Sheets(„Tabelle1“).Range(„A1“).Value 'bild

Range(„B1“).Select
Set Picture = ActiveSheet.Pictures.Insert(s)'1.
Picture.ShapeRange.Name = „bi1“'2.
Picture.ShapeRange.Height = 160 '3.

If Picture.ShapeRange.Width > 214 Then’4.
Picture.ShapeRange.Width = 214 'breite verändern
End If

'oder
'If Picture.ShapeRange.Height > 160 Then
'Picture.ShapeRange.Height = 160 'höhe verändern
'End If

Picture.ShapeRange.IncrementLeft -8000 '5.
Picture.ShapeRange.IncrementTop -8000 '6.
Picture.ShapeRange.IncrementTop 65 'von oben’7.
Picture.ShapeRange.IncrementLeft 28 'von links’8.

End Sub

mfg
rolandaa

Anonym_5b813eba76fe · 14. November 2019 um 03:06

Hallo echojuergen,

da die Antwort sehr umfangreich wäre verweise ich Dich auf eine tolle website zu diesem Thema:

http://hajo-excel.de/vba_bild_eingabe.htm

Gruß,
Ptonka