AW: Hat keiner eine Idee?
29.05.2018 13:06:05
ChrisL
Hi Antonio
So...
https://www.herber.de/bbs/user/121876.xlsm
Die Bildkoordinaten kannst du anhand der Werte berechnen. Die ganze Hilfstabelle braucht es nicht.
Beispiel Vertikale (vereinfacht):
Bildhöhe - (6 * Punkthöhe) = Total Abstand zwischen den Punkten
Abstand / 12 = Abstand oben und unter je Punkt
Anzahl Punkte * Höhe Punkt + Anzahl Punkte * Abstand = Top Wert
Zuzüglich Top-Wert vom Bild
Anstelle der komplexen API-Funktion, welche Shapes im Userform erzeugt, verwende einfach Bilder als Punkte.
cu
Chris
Private Sub cbx1_Change()
Dim i As Integer
ListBox1.Clear
Call PunkteAusblenden
If cbx1 "" Then
For i = 17 To 95 Step 6
With Worksheets("Chord1")
ListBox1.AddItem .Cells(cbx1.ListIndex + 1, i)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(cbx1.ListIndex + 1, i + 1)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(cbx1.ListIndex + 1, i + 2)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(cbx1.ListIndex + 1, i + 3)
ListBox1.List(ListBox1.ListCount - 1, 4) = .Cells(cbx1.ListIndex + 1, i + 4)
ListBox1.List(ListBox1.ListCount - 1, 5) = .Cells(cbx1.ListIndex + 1, i + 5)
End With
Next i
End If
End Sub
Private Sub ListBox1_Click()
Dim i As Integer, intWert As Integer
If ListBox1.List(ListBox1.ListIndex, 0) = "" Then
Call PunkteAusblenden
Exit Sub
Else
Call PunkteEinblenden
End If
For i = 6 To 1 Step -1
Controls("Punkt" & i).Top = Image1.Top + (((Image1.Height - (Punkt1.Height * 6)) / 12) _
* (((i - 1) * 2) + 1)) + ((i - 1) * Punkt1.Height)
If ListBox1.List(ListBox1.ListIndex, i - 1) = "x" Then
intWert = 1
Else
intWert = ListBox1.List(ListBox1.ListIndex, i - 1) + 1
End If
Controls("Punkt" & i).Left = Image1.Left + (((Image1.Width - (Punkt1.Width * 16)) / 32) * _
(((intWert - 1) * 2) + 1)) + ((intWert - 1) * Punkt1.Width)
Next i
End Sub
Private Sub UserForm_Initialize()
With Worksheets("Chord1")
cbx1.List = Application.Transpose(.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row))
End With
End Sub
Private Sub PunkteEinblenden()
Dim i As Integer
For i = 1 To 6
Controls("Punkt" & i).Visible = True
Next i
End Sub
Private Sub PunkteAusblenden()
Dim i As Integer
For i = 1 To 6
Controls("Punkt" & i).Visible = False
Next i
End Sub
