MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 24.08.2012, 14:38   #1
michael96
Neuer Benutzer
Neuer Benutzer
Standard VBA - pfad aus mehreren zellen lesen und objekt nebenan uebergeben

Hallo,

ich habe einen zusammengestellten code aus dem forum umgeschrieben damit er meinen beduerfnissen entsprechend arbeitet. Ich moechte dass man einen pfad in mehrere zellen eingeben kann und daneben dann die bilder angezeigt werden. Leider bekomme ich aber keine fehlermeldung und weiss nicht so recht was an meinem code nicht stimmt.

Private Sub PictureViewer()
On Error Resume Next
Dim i As Long
Dim Picture As Object
Dim Path As String
Dim ii As Long
Dim verz As String
Range("$B$3").Select 'hier wird der Ordnerpfad eingegeben
verz = Selection
ChDir verz 'wechselt das Verzeichnis aus Zelle B3
Rows(5).ClearContents 'Löscht die Daten, jedoch nicht die Formatierung.
Range("B5").Select 'Erste Zelle die später befüllt wird
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = False 'Unterordner werdenn nicht durchsucht
.FileType = msoFileTypeAllFiles
.Execute
For i = 1 To .FoundFiles.Count
ActiveCell.Value = .FoundFiles(i) 'schreibt Pfad+Bildname in Zelle
ActiveCell.Offset(0, 1).Select

'springt zur naechsten Zelle und schreibt naechsten Pfad+Bildname in Zelle

Next i
Range("C1").Value = i - 1 & " pictures in file"

'gibt an wie viele Bilder im Ordner gefunden wurden

End With
End Sub


Diesen Code habe ich in nachfolgenden umgewandelt und muss wohl einen fehler drin haben. es kommt aber keine fehlermeldung.

Private Sub ShowPictures()
On Error Resume Next
Dim i As Long
Dim Picture As Object
Dim Path As String
Dim ii As Long
Dim verz As String
For iii = 21 To 30 'soll Bilder anzeigen fuer Pfade in B21 bis B30
If Cells(iii, 2) = "" Then 'falls Pfad nicht angegeben Anwendung beenden
Exit Sub
End If
Cells(iii, 2).Select 'hier wird der Ordnerpfad entnommen
verz = Selection
ChDir verz 'wechselt das Verzeichnis aus Zelle
Range("C21").Select 'Erste Zelle die später befüllt wird
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = False 'Unterordner werden nicht durchsucht
.FileType = msoFileTypeAllFiles
.Execute
For i = 1 To .FoundFiles.Count
ActiveCell.Value = .FoundFiles(i) 'schreibt Pfad+Bildname in Zelle
ActiveCell.Offset(0, 1).Select

'springt zur naechsten Zelle und schreibt naechsten Pfad+Bildname in Zelle

Next i

Range("C1").Value = i - 1 & " pictures in file" 'gibt an wie viele Bilder im Ordner gefunden wurden

End With
Next iii
End Sub

Kann mir jemand damit helfen
michael96 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.08.2012, 15:08   #2
Hajo_Zi
MOF Guru
MOF Guru
Standard

Hallo michael,

könnte es daran liegen das bei Deiner Version 2010 den Befehl Application.FileSearch
nicht mehr gibt?

GrußformelHomepage

__________________

Signatur in jedem Beitrag
Bitte Version angeben. Bei keiner Angabe gehe ich von meinen Angaben aus.
Betriebssystem: Windows 10 - 64 Bit, Office 2016 - 32 Bit.
Fragen werden im Forum beantwortet, nicht per PN.

Beitrag bewerten.
Am Beitrag unten Links, mittleres Symbol, rechte Maustaste, im neuen Fenster öffnen.
Hajo_Zi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.08.2012, 16:32   #3
michael96
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Halo Hajo,

danke fuer Deine Antwort. Daran liegt es nicht, weil ich jetzt auf excel 2003 arbeite. Ich habe den code aber umgeaendert und er funktioniert jetzt auch wenn es sicher nicht die beste Art is.

Private Sub ShowPictures()
On Error Resume Next

Dim i As Long 'Zähler, um aus Datei Pfad für jedes Bild zu erfassen
Dim Picture As Object
Dim Path As String
Dim j As Long 'j Spalten (von FP) bis Anzahl Bilder
Dim verz As String
Dim k As Long 'k gibt die Zeile an die beschrieben wird

Rows("4:2000").Select
Selection.RowHeight = 45 'legt die Höhe der Zeilen fest (damit Bilder sich nicht überlappen)

For k = 4 To 14 'soll Bilder anzeigen fuer Pfade in FO4 bis FO50
Cells(k, 171).Select 'hier wird der Ordnerpfad entnommen, ab Zelle FO4 in Spalte FO
verz = Selection
ChDir verz 'wechselt das Verzeichnis aus Zelle
Cells(k, 172).Select 'erste Zelle die später befüllt wird, 172 steht hier für Spalte FP

With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = False 'Unterordner werdenn nicht durchsucht
.FileType = msoFileTypeAllFiles
.Execute
For i = 1 To .FoundFiles.Count
ActiveCell.Value = .FoundFiles(i) 'schreibt Pfad+Bildname in Zelle
ActiveCell.Offset(0, 1).Select 'springt zur naechsten Zelle und schreibt naechsten Pfad+Bildname in Zelle

Next i
End With
Application.ScreenUpdating = False 'ab hier werden die Bilder angezeigt
For j = 172 To Cells(k, Columns.Count).End(xlUp).Column
Path = Cells(k, j).Value
Set Picture = ActiveSheet.Pictures.Insert(Path)
With Picture
.Left = Cells(k, j).Left
.Top = Cells(k, j).Top
If .ShapeRange.Width > .ShapeRange.Height Then
.ShapeRange.Width = 50 'legt fest wie Breit die angezeigten Bilder sein sollen
Else
.ShapeRange.Height = 50 'legt fest wie Hoch die angezeigten Bilder sein sollen
End If
End With
Set Picture = Nothing
Next j
Application.ScreenUpdating = True
Call prcReset 'started das Modul1 in dem die Bilder dann vergrössert und verkleinert werden
Range("FP4:IV50").ClearContents 'löscht Pfad aus Zellen, Bilder bleiben bestehen
Next k
End Sub

Wie gesagt der Code macht jetzt was ich beabsichtigt habe, aber durchlaeuft er immer alle Zellen mit Pfadeingabe und erstellt alle Bilder neu. Kann man das aendern und nur eine 'aktuelle' Zelle bearbeiten lassen? Also irgendwie mit ActiveCell usw??

Lg,
Michael
michael96 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:20 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.