Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
624to628
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

alle Bilder eines Ordners öffnen

alle Bilder eines Ordners öffnen
20.06.2005 19:47:49
Rocky
Hallo Leute,
ich möchte alle bilder eines bestimmten Ordner (immer der gleiche) öffnen.
jedes Bild soll dann nach einander in in Spalte A von eins an abwärtz eingefügt werden! Die Zellen haben bereits die dafür erforderliche größe.
wenn ihr auch noch wisst wie man jedes bild auf 48% verkleinert wäre das noch besser!
danke für eure bemühungen
Gruß ROCKY

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: alle Bilder eines Ordners öffnen
20.06.2005 19:59:09
Hajo_Zi
Hallo Rocky,
passse Dir folgendes Mako an.

Sub Sammeln2()
'    Bildgröße verändern
Dim Höhe As Integer
Dim SHöhe As Single
Dim Breite As Integer
Dim SBreite As Integer
Dim J As Integer
Dim Wert1
Höhe = 34
Breite = 5
SBreite = 1
SHöhe = 2
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
strVerzeichnis = "D:\Eigene Dateien\Eigene Bilder\Bilder\Sammeln"
strDatei = Dir(strVerzeichnis & "\*.jpg")
Cells(SHöhe, SBreite).Select
Cells(SHöhe - 1, SBreite) = strDatei    ' schreiben Dateinamen
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)  ' einfügen Bild
'With ActiveSheet.Shapes("Picture 1")
ActiveSheet.Shapes("Picture 1").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 400.75
'    Selection.ShapeRange.Width = 113.25
'    End With
J = 2
SHöhe = SHöhe + Höhe
Do While strDatei <> ""
strDatei = Dir()
If strDatei = "" Then Exit Do
Cells(SHöhe, SBreite).Select
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
ActiveSheet.Shapes("Picture " & J).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 400.75
'        Selection.ShapeRange.Width = 113.25
J = J + 1
Cells(SHöhe - 1, SBreite) = strDatei
SHöhe = SHöhe + Höhe
If SHöhe >= 65500 Then
SBreite = SBreite + Breite
SHöhe = 2
End If
Loop
End Sub

Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.


Anzeige
Danke werd's ausprobieren meld mich o.T.
20.06.2005 20:02:15
Rocky
Auf select kann verzichtet werden! 0T
20.06.2005 20:29:39
Jan
0T
AW: alle Bilder eines Ordners öffnen
20.06.2005 20:46:33
Rocky
Hallo nochmal,
hab ausprobiert und muss leider sagen dass es nicht funktoniert!
keine ahnung warum, denn son komplizierten code kann ich nicht lesen!
kann nur so einfache befehle erkenn!
er fügt zwar alle bilder ein aber wo er will. und nicht in spalte A zelle für zelle Abwärts!
auf den namen des Bildes könnt ich verzichten. die größe macht er nicht denn da bleibt er stecken! ich glaub er findet die bilder nicht! vieleicht weil sie schon nen namen haben?
kann man vileicht mit for each arbeiten?
danke trotzdem für die schnelle hilfe
Gruß Rocky
AW: alle Bilder eines Ordners öffnen
20.06.2005 20:59:38
Hajo_Zi
Hallo Rocky,
mit Bilder einfügen befasse ich mich nur nebenbei. Der Code ist aus meinem Archiv vom Jahr 2003. Warten wir mal darauf das Jan den Code umstellt auf ohne Select. Ich vermute mal er wird Deine Wünsche gleich einarbeiten.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige
AW: alle Bilder eines Ordners öffnen
20.06.2005 21:46:54
Jan
Hi,
bei deinem Level schaffst du das auch allein, ohne select auszukommen, oder?
mfg Jan
@ Jan - Hilfe bitte bitte
20.06.2005 21:05:21
Rocky
HAllo;
vileicht hast du ne idee?
also noch mal mein problem:
hab einen Ordner mit verschieden vielen Datei (jpg)
eine Datei zur präsentation (in Tabelle1)
nun soll in jede Celle der spalte A (größe bereits richtig) ein bild eingefügt werden
der Harken ist das dafür das bild auf 38% verkleinert werden muss
kann man das lösen?
Frage noch offen OT
20.06.2005 21:08:02
Rocky
AW: Frage noch offen OT
21.06.2005 00:09:56
Josef
Hallo Rocky!
Probier's mal so!
Option Explicit

Sub BilderEinfuegen()
    'by J.Ehrensberger
    
    Dim fSearch As FileSearch
    Dim strPath As String
    Dim iCnt As Integer
    Dim pic As Picture
    
    On Error GoTo ERRORHANDLER
    Application.ScreenUpdating = False
    
    ' "alte" Bilder löschen
    ActiveSheet.Pictures.Delete
    
    'Pfad anpassen
    strPath = "C:\Dein Verzeichnis"
    
    Set fSearch = Application.FileSearch
    
    With fSearch
        .NewSearch
        .LookIn = strPath
        .SearchSubFolders = False '<<<<Unterordner durchsuchen True/False
        .FileType = msoFileTypeAllFiles
        .Filename = "*.jpg" '<<<<Dateiendung
        .Execute
        
        If .Execute() > 0 Then
            
            'gefundene Dateien durchlaufen
            For iCnt = 1 To .FoundFiles.Count
                'Bild einfügen
                Set pic = ActiveSheet.Pictures.Insert(.FoundFiles(iCnt))
                'Größe anpassen und ausrichten
                With pic.ShapeRange
                    .LockAspectRatio = msoTrue
                    .Left = Cells(iCnt, 1).Left
                    .Height = Cells(iCnt, 1).Height
                    .Top = Cells(iCnt, 1).Top
                End With
                
                Set pic = Nothing
                
            Next
            
        End If
        
    End With
    
    Set fSearch = Nothing
    
    ERRORHANDLER:
    Application.ScreenUpdating = True
End Sub




Gruß Sepp
P.S.: Rückmeldung nicht vergessen!


Anzeige
Funktioniert super! DANKE OT
21.06.2005 17:17:41
Rocky
ot

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige