Ich möchte gerne für meine Rangliste, die in Excel schon
existiert, automatisch aus der Tabelle eine Bilder-Pyramide
generieren lassen.
Als Vorlage wollte ich „A2-A17“ vom Blatt „Daten“ nehmen. Der
Pfad zu den Bildern steht in „U2-U17“. Aussehen sollte es
möglichst wie im Blatt „Bilder-Pyramide“. Zum besseren
Verständnis habe ich auch die komplette Rangliste hochgeladen.
Hallo Daniel,
habe den Code im Modul Bilder_Pyramide umgeschrieben, ersetze bitte den alten durch den neuen Code.
Zum Verständnis und für deine Anpassungen, Grafiken und Textboxen werden beim Einfügen durch die Angabe von Top,Left,Weight,Height positioniert.
Die obere linke Ecke des Tabellenblatts hat Top=0 und Left=0. Auf diese Ecke beziehen sich die Angaben von Top und Left der Bilder bzw Textboxen. Mit dem Wissen kannst du die Positionen und Größen leicht anpassen.
Wenn du die Textboxen (Namenskästchen) farbiger willst, so zeichne dir am besten ein Makro auf wo du eine Textbox mit beliebigem Text erstellst (Ansicht–Symbolleisten–Zeichnen), dann mit rechts drauf klicken und Textfeld formatieren auswählen. Dann farbe festlegen, Makro beenden. Dann den Code des Makros anschauen und dort die Einträge die die Frabe betreffen in meinen Code übernehmen.
Dein sortieren scheint nicht zu funktionieren!?
Gruß
Reinhard
Sub Bilder\_einfuegen()
Bildhöhe = 100
Bildbreite = 75
VA = 20 'vertikaler Abstand zwischen den Bildern in Pukten
HA = 20 ' horizontale Abstand zwischen den Bildern
Dim PosT(16) ' Top-Position der Bilder
Dim PosL(16) ' Left-Position der Bilder
Worksheets("Bilder-Pyramide").Activate
Bilder\_loeschen
anz = Worksheets("Daten").Range("U65536").End(xlUp).Row - 1 'Anzahl Einträge in Rangliste
PosT(1) = 0
PosL(1) = 300
For n = 2 To 4
PosT(n) = PosT(1) + Bildhöhe + VA
PosL(n) = PosL(1) - Bildbreite - HA + (n - 2) \* (Bildbreite + HA)
Next n
For n = 5 To 9
PosT(n) = PosT(2) + Bildhöhe + VA
PosL(n) = PosL(2) - Bildbreite - HA + (n - 5) \* (Bildbreite + HA)
Next n
For n = 10 To 16
PosT(n) = PosT(5) + Bildhöhe + VA
PosL(n) = PosL(5) - Bildbreite - HA + (n - 10) \* (Bildbreite + HA)
Next n
For n = 1 To anz
Worksheets("Bilder-Pyramide").Pictures.Insert(Worksheets("Daten").Cells(n + 1, 21)).Select
Selection.Top = PosT(n)
Selection.Left = PosL(n)
Selection.Height = Bildhöhe
Selection.Width = Bildbreite
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, PosL(n), PosT(n) + Bildhöhe, \_
Bildbreite, 20).Select
Selection.Characters.Text = n & ". " & Worksheets("Daten").Cells(n + 1, 2)
With Selection.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.HorizontalAlignment = xlCenter
Next n
Range("a1").Select
End Sub
Sub Bilder\_loeschen()
Dim bild As Shape
For Each bild In ThisWorkbook.Worksheets("Bilder-Pyramide").Shapes()
bild.Delete
Next bild
ThisWorkbook.Worksheets("Bilder-Pyramide").UsedRange.ClearContents
End Sub
)