Excel Makro Bilder aufrufen und einfügen

Computer: Software & Programmierung Visual Basic
#1

Ich habe in Makro erstellt, in ein vorgefertigtes Excel Formular 4 Bilder automatisch einzufügen.
Ich klicke eine Zelle (D28, D52, D76 oder D100) an schreibe die Bildnummer nach RETURN wird das Bild engefügt.
Da die Bildnummer machmal sehr lang ist bzw. aus dem Gedächtnis eingetragen werden muss, wollte ich, dass nach dem anklicken auf die Zelle der dateimanager aufgerufen wird, und ich von dort aus das Bild anklicken kann.
Das Verzeichnis und Unterverzeichnis habe ich im Makro schon hinterlegt. Das Unterverzeichnis ist die Schadennummer, welche im Formular in der Zelle D5 hinterlegt ist.
D:\Bilder\Schadennummer…Bilder

Private Sub Worksheet_Change(ByVal Target As Range)
'***********************************************
'* Jürgen Nagel *
'* *
'***********************************************
Dim SNZelle As String
Dim StOrdner As String ’ Variable Ordner Bildablage
Dim StBild As String ’ Variable Bildname
Dim InI As Integer ’ Variable Schleifenzähler
Dim RaBereich As Range ’ Variable Bereich der Gültigkeit
Dim RaZelle As Range ’ Variable bearbeitete Zelle
Dim LoBreite As Long ’ Variable Bildbreite
Dim LoHoehe As Long ’ Variable Bildhöhe
SNZelle = „“

’ Ordner Bildablage
StOrdner = „d:\Bilder“ & Range(„D5“) & SNZelle ’ Verzeichnis "D:\Bilder+„Schadensnummer“ aus Zelle D5+ „“

Set RaBereich = Range(„D28,D52,D76,D100“) ’ Bereich der Wirksamkeit

Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then ’ falls nicht gefunden wird sub verlassen
For Each RaZelle In RaBereich ’ Schleife über alle veränderten Zellen
Application.EnableEvents = False ’ Reaktion auf Zellveränderung abschalten
RaZelle.Offset(0, 1) = „“ ’ Inhalt der Zelle neben Bildnamen löschen
Application.EnableEvents = True ’ Reaktion auf Zellveränderung einschalten
’ Bildname erstellen
StBild = "Bild " & RaZelle.Address(False, False)
’ altes Bild löschen von jinx
For InI = ActiveSheet.Shapes.Count To 1 Step -1
If ActiveSheet.Shapes(InI).Name = StBild Then
ActiveSheet.Shapes(InI).Delete
Exit For
End If
Next
’ ************
If RaZelle.Value „“ Then ’ eine Eingabe ist vorhanden
’ Bildname einschl. Ordner erstellen

StBild = StOrdner & Format(RaZelle.Value, „“) & „.jpg“
If Dir(StBild) = „“ Then ’ Prüfung ob Bild vorhanden
Application.EnableEvents = False ’ Reaktion auf Zellveränderung abschalten
’ Bild nicht vorhanden
Target.Offset(0, 4) = „Kein Bild vorhanden!“
Application.EnableEvents = True ’ Reaktion auf Zellverändeung einschalten
Else ’ Bild vorhanden
’ Bildgröße und Bild bei Position einfügen
Select Case Target.Address(False, False)
Case „D28“
LoBreite = 635
LoHoehe = 395
’ einfügen ohne select
’ Ausdruck.AddPicture(FileName, Verknüpfung,in Mappe speichern,
’ Pos. Links, Pos. Oben, Breite, Höhe)
’ von Jürgen Nagel
’ erstes Offset Pos. Links 0 Zeilen und eine Spalte nach rechts
’ zweites Offset Pos. Oben 0 Zeilen tiefer und 0 Spalten nach rechts
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
’ ********
Case „D52“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
Case „D76“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
Case „D100“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
End Select
End If
End If
Next RaZelle
End If
Set RaBereich = Nothing ’ Variable leeren
End Sub

#2

Hallo,

die Funktionalitaet des Dateiauswahldialogs ist im Application Object eingebaut.
ewt. musst du um dieses verwenden zu koennen den Verweis auf die Office-Biblikothek unter EXTRAS->Verwese einstellen.

foldener Code ruft den Dialog auf und gibt die ausgeawhlten Dateien zurueck:

==================================================

Dim dlgOpen As Object
Dim dlgItem as Object

’ First get the Filename with a Standart FileDialog
Set dlgOpen = Application.FileDialog(1)

With dlgOpen
.Title = „Dokument wählen“
.AllowMultiSelect = True ’ = False : only one item is selectable
.Title = „Dialog Ueberschrift“
’ Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add „JPG Bild“, „*.JPG“
.Filters.Add „Bitmap“, „*.BMP“
.Filters.Add „All Files“, „*.*“ ’ use same theme for more
.InitalFileName = „C:\Temp\Bilder“ 'start directory
.Show
End With

’ Work with selected files
If dlgOpen.SelectedItems.Count > 0 Then

For Each dlgItem in dlgOpen.SelectedItems

’ Hier kommt die Verarbeitung der Dateinamen hin, was auch immer du damit vorhast

next dlgItem

Weiter Optionen fuer Filedialog kann in Objektbrowser in der VBA-IDE nachschauen

Hope this helps
Peter

#3

Hallo echojuergen,

da bist Du viel weiter als , da kann mein Tipp sicherlich nicht sonderlich helen.
Hier etwas wa sich selbst mal irgendwo im Netz gefunden habe. War dazu bestimmt in einem Verzeichnis alle file´s aufzuzeigen.

Sub dateinazeigen()
Dim strOrdnerName As String
Dim strName As String
Dim intz As Integer

Range(„A:A“).Clear

strOrdnerName = InputBox(„Verzeichnis:“)
strName = Dir(strOrdnerName & „*.*“)
Cells(1, 1).Value = strName

Cells(2, 1).Activate

Do While strName „“
strName = Dir
intz = intz + 1
ActiveCell.Value = strName
ActiveCell.Offset(rowoffset:=1, columnoffset:=0).Activate
Loop
MsgBox "Anzahl Dateien: " & intz

End Sub

Gruß Hugo

#4

Hallo echojuergen,

… Bilder automatisch einzufügen.
anklicken auf die Zelle der dateimanager aufgerufen wird, und
ich von dort aus das Bild anklicken kann.

da Du offensichtlich schon VBA-Erfahrung hast, konzentriere ich mich auf die gefühlte wesentliche Frage: wie kann ich über den Dialog ein Bild einfügen?

Option Explicit

Dim PName As Variant, FName As Variant

Sub Bild_Einfuegen()
On Error Resume Next
PName = Application.GetOpenFilename(„All files (*.*),*.*“)
If PName = False Then Exit Sub
FName = Dir(PName)
ActiveSheet.Pictures.Insert(FName).Select
End Sub

Getestet habe ich das mit Office 2010. Das Makro ruft den Dialog ohne Vorbelegung auf. Das Bild wird in die aktive Zelle eingefügt (linke, obere Ecke). Das drumherum bekommst Du sicher selbst hin, oder?

Mit freundlichen Grüßen MwieMichel

#5

Hallo echojuergen,
so bekommst du einenn Dialog in Excel

Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
 Dim fd As FileDialog
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 fd.InitialFileName = "c:\users"
 fd.AllowMultiSelect = False
 fd.Show
 file = fd.SelectedItems(1)
End Sub

MfG
W.W.

#6

wenn ich richtig verstanden habe, fehlt dir noch der hyperlink.
wennst auf die schadens nummer klickst das zum schadens bild gelangst auf der festplatte?

#7

Hi Manfred,
ja genau das, Bild richtig einfügen, habe ich schon.

wenn ich richtig verstanden habe, fehlt dir noch der
hyperlink.
wennst auf die schadens nummer klickst das zum schadens bild
gelangst auf der festplatte?

#8

Hi

lade deine datei hoch das ich mir dein problem ansehen kann

#9

Hallo!
Es gibt eine Hilfe, mit der Du den Dateipfad (mit Namen!) ins Clipboard kopieren kannst: Datei im Explorer suchen, recht anklicken, „Pfad kopieren“ auswählen. Google mal nach „clipboardPath“. Dann kannst du aus dem Clipboard den vollständigen Dateinamen wieder einfügen. Wars das?

Gruß
Wolfram

#10

Hallo Echojuergen,

Es gibt einen Befehl mit dem sich ein Dateiöffnen-Dialog ansprechen läßt, er fällt mit nur gerade nicht ein. Dauert bis morgen (wenn ich wieder an meinem Arbeitsplatz bin…) ich schreibe morgen (2013-01-17) noch mal.

Bis dann,

Matthias

#11

Hallo echojuergen,

ich würde das mit einer Ereignisprozedur im Tabellenblatt lösen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = „$D$28“ Then '…Or Target.Address = „…“ oder jede Zelle einzeln prüfen
Application.Dialogs(xlDialogOpen).Show („D:\Bilder\Schadennummer…*.jpg oder png oder was auch immer“)

End If
End Sub

Mit Target.Address frägst Du ab, ob die 4 Zellen betroffen sind. Wenn ja, dann öffnest Du den Standard-Dialog zum Öffnen von Dateien. Dieser ist parametrierbar (z. B. Startverzeichnis, Filter für Dateitypen, etc.)

Damit sollte es lösbar sein.

Gruß
Harry

#12

Hallo Echojuergen,

der Befehl lautet

application.getOpenFilename
(„JPEG Files (*.jpg), *.jpg“,_
1, „Bilddatei auswählen“)

Es empfiehlt sich, zuvor mit CHDRIVE und CHDIR (bei anderem Laufwerk als C: bitte auch in dieser Reihenfolge, sonst landest Du immer wieder in C:smile: das Excel-Standardverzeichnis umzustellen auf das Verzeichnis, in dem sich Deine Bilder befinden.
Der Befehl öffnet den „Datei öffnen“ Dialog und gibt als Ergebnis den ausgewählten Dateinamen oder nix (bei abbrechen, mußt Du abfragen) zurück.

Danach kannst Du es wie gehabt weiter bearbeiten.

Viel Erfolg, schreib’ mal obs klappt!

Mit freundlichem Gruße,

Matthias

#13

Hallo,

ich glaube, hier gibt es schon genug Ideen.

Viel Erfolg!

#14

Hallo,
ich hab zu dem Thema auch eine Frage. Ich will in eine Zelle ein Bild einfühen, wobei ich den Pfad aus Zellen zusammensetze. Das hat hiermit auch gut funktioniert:

Sub Bild_einfügen()
Const strPATH = „C:\Users\Desktop\Makro\Artikelbilder“
M = „C016510100000“

Range(„A5“).Select
ActiveSheet.Pictures.Insert (strPATH & „C016510100000“ & „.jpg“)
End Sub

Was ich nicht schaffe, ist das Bild sauber an die Zellengröße anzupassen, ohne das Bild zu verzerren. und das hier scheint nicht kompatibel:
Selection.ShapeRange.LockAspectRatio = msoTrue

Vielen Dank für die Hilfe

#15

Hallo,
ich hab zu dem Thema auch eine Frage. Ich will in eine Zelle ein Bild einfühen, wobei ich den Pfad aus Zellen zusammensetze. Das hat hiermit auch gut funktioniert:

Sub Bild_einfügen()
Const strPATH = „C:\Users\Desktop\Makro\Artikelbilder“
M = „C016510100000“

Range(„A5“).Select
ActiveSheet.Pictures.Insert (strPATH & „C016510100000“ & „.jpg“)
End Sub

Was ich nicht schaffe, ist das Bild sauber an die Zellengröße anzupassen, ohne das Bild zu verzerren. und das hier scheint nicht kompatibel:
Selection.ShapeRange.LockAspectRatio = msoTrue

Vielen Dank für die Hilfe … mehr auf