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
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
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
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
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.
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
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
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
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
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)
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
(.