angefügt findet ihr eine vereinfachtete Form meiner
Excel-Datei! Mein Ziel ist es nun, dass wenn ich die
Checkboxen aktiviere, dass diese dann per Knopfdruck (nur die
ausgewählten) mit ihrem kompletten Datensatz in eine neue
Tabelle (im gleichen Dokument) kopiert werden.
Die Schwierigkeit liegt darin, dass ich die Bilder der
einzelnen Datein mit kopieren muss.
Hallo Star,
ich hoffe du hast da noch nicht zuviele Datensätze mit Bildchen frei Hand angelegt.
Ich würde so vorgehen bzw. dir empfehlen, lösche die Kontrollkästchen und nimm die aus Steuerelemtntoolbox.
Spalte B, wozu brauchste die? Kann ggfs. weg.
Man kann sich auch durch Chaos hangeldn aber einfacher und pflegeleichter ist, der Grundaufbau ist geordnet.
D.h., wenn in/auf Zelle A5 eine Checkbox ist sollte auch die linke obere Ecke des Bildes auf F5 sein.
(Jedes Bild ist für Excel rechteckig und um die linke obere Ecke geht es)
Dann kann man bequem per Makro jeder CheckBox und jedem Bild einen Namen verpassen indem der Zellname auftaucht über der es steht.
Was dann bedeutet, ist CheckA5 angehakt, wird BildA5 kopiert usw.
Damit das funktioniert, müßtest du jetzt im Moment manuell deine Bildchen bezüglich der linken oberen Ecke verschieben bis es passt.
Grundsätzlich wäre es ggfs. besser gewesen, die Pfade und Bilddateinamen augzulisten und dann die Checkboxen und Bilder von Vba einfügen zu lassen, dann stehen sie sauber untereinander.
Vielleicht verstehst du besser was ich sagen will wenn du etwas siehst.
Erstelle mal eine Kopie deiner Datei. In der drückst du Alt+F11.
Dort Einfügen—Modul.
In das Modul fügst du nachfolgenden Code ein.
Dann drücke F5.
Die Bilder werden posintioniert in Bezug auf Links und Höhe, in den Spalten H,I,J steht der neue Bildname, der name der Bilddatei und der Pfad.
Option Explicit
Sub Benennen()
Dim S As Shape, Anz
With Worksheets("Tabelle1")
For Each S In .Shapes
If S.Name Like "Grafik\*" Then
S.Name = "Bild" & S.TopLeftCell.Address
S.Top = S.TopLeftCell.Top
S.Left = S.TopLeftCell.Left
'S.Height = 20
'S.Width = 20
End If
If S.Name Like "Check\*" Then
S.Name = "Check" & S.TopLeftCell.Address
End If
Next S
For Each S In .Shapes
If S.Name Like "Bild\*" Then
Anz = Anz + 1
.Cells(Anz, 8) = S.Name
.Cells(Anz, 9) = Mid(S.AlternativeText, InStrRev(S.AlternativeText, "\") + 1)
.Cells(Anz, 10) = Left(S.AlternativeText, InStrRev(S.AlternativeText, "\") - 1)
End If
Next S
End With
End Sub
Gruß
Reinhard