Fotoalbum auf VBA Basis

Hallo Ihr Lieben, ich habe mal eine generelle Frage, ob sich mein Vorhaben über VBA umsetzen lässt: es geht um folgendes:

Ich möchte in einem UserForm Lichtbilder eines Ordners anzeigen, diese dort in eine richtige Reihenfolge bringen, unnötige Bilder löschen, Bilder um 90 drehen können und neben oder unter jedem Bild einen Text schreiben können.

Die Bilder sollten im Anschluss dann in eine Word Vorlage oder Excel Vorlage übertragen werden. Genial wäre, wenn man das User vom öffnen könnte und danach weiter editieren könnte.

Jetzt habe ich mich bereits schon ein bisschen schlau gemacht, habe allerdings nur einen Teil Erfolg verbuchen können.

Hier ist ein UserForm, dass sortieren kann. Leider weiß ich nicht, wie das weiter um die og Funktionen erweitert werden kann.

Hier der Link dazu.

https://www.herber.de/bbs/user/74527.xls

Meine Frage ist, ob schon mal jemand so etwas probiert hat, gegebenfalls gibt es ja schon eine Vorlage, die ich verwenden könnte. Es ist mir ein besonderes Anliegen, was ich gerne mit eurer Hilfe verwirklichen würde. Benutzt werden soll. Das Ganze für die Freiwillige Feuerwehr, wir wollen aus unseren Lichtbildern, die wir am Brandort machen, eine ordentliche Lichtbildmappe kreieren. Es wäre toll, wenn uns hier jemand unterstützen könnte.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo miteinander,
es ist kein Aufwand in der Listbox2 dieses Tools per Drag&Drop (linke Maustaste gedrückt halten und dann in Liste verschieben) das Ganze zu sortieren.



Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then

        With New DataObject

            .StartDrag 2

        End With

        ListBox2.ListIndex = 0

    End If

End Sub

Private Sub ListBox2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, _

    ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

    Cancel = True

End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, _

    ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _

    ByVal Shift As Integer)

    Dim yZeile As Double, ySpalte&



    If Effect = 2 Then

        With ListBox2

            yZeile = Y  (.Font.Size * 1.1)

            .AddItem .Column(0), yZeile

            For ySpalte = 0 To 2

                .List(yZeile, ySpalte) = .Column(ySpalte)

            Next ySpalte

            .RemoveItem .ListIndex

        End With

     End If

End Sub

Es ist ein Codeschnipsel (Variablen kann jeder selbst deklarieren). Das war es auch schon.
Das Problem ist aber ein ganz Anderes.
Gut, es ist eine Demo!
Die Datei ist leider derart instabil, dass wenn man zügig in Listbox2 die Einträge anklickt das Image2 Control abschmiert. Es sind auch noch weitere Fehler drin.
Ich denke mal in der fertigen Version passiert so was nicht.

Ich vermute jetzt mal, dass FFW da so nicht weiterkommt.
Man kann, wenn klar ist was wie wohin soll (Ausgabe in Listenform oder neues Tabellenblatt für jedes Ereignis) mit Bildbeschreibung zum verlinkten Bild (öffnen mit Standartbildbetrachter) oder wie auch immer dies zusammenstellen.
Hier sollte aber, auch wenn FFW auf Ehrenamt verweist, eine digitale Gemeinnützigkeit (Spende Wikipedia o.ä.) fällig sein.
Denke bitte mal in Ruhe darüber nach.
Anbei mal deine Datei mit ein paar Anpassungen, welche Bilderserien bis zu 160 Bildern zulässt (auswählbar über Combobox). Das Ganze wird in einem scrollbaren Frame geladen.
https://www.herber.de/bbs/user/163280.xlsm

Gruß Uwe

Private Sub CommandButton2_Click() Dim objCtrl As MSForms.Control Dim lngRow&, lz& 'Columns(1).ClearContents lz = Tabelle2.Cells(Rows.Count, 2).End(xlUp).Row + 1 For Each objCtrl In Me.Controls If TypeOf objCtrl Is MSForms.Image Then With objCtrl If .ControlTipText > "" Then lngRow = lngRow + 1 With Tabelle2 .Activate .Cells(lz, lngRow + 1).Select .Pictures.Insert(objCtrl.ControlTipText).ShapeRange.Height = lngHeight .Cells(lz, lngRow + 1).RowHeight = lngHeight .Cells(lz, lngRow + 1).ColumnWidth = 20 .Cells(lz + 1, lngRow + 1) = Right(objCtrl.ControlTipText, Len(objCtrl.ControlTipText) - InStrRev(objCtrl.ControlTipText, "")) End With End If End With End If Next End Sub

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fotoalbum auf VBA Basis

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread