VBA: 4 Schritte mit Schleife lösen
24.06.2016 14:55:08
Hewad
ich habe ein Blasendiagramm auf einem Sheet, beidem ich die einzelnen Blasen, in den jeweiligen Reihen, mit Bildern befülle. Die Reihenfolge der Bilder bestimme ich über einen im Sheet (Zelle:B62) und den Namen des Bildes - welches geladen werden soll - von der Bachbarzelle (c62).
Mein Problem ist, dass ich für jede Reihe einen Code habe (insgesamt gibt es 4 Reihen im Chart mit mehreren Blasen), die ich alle 4 über "Call" mit einem Makro ausführe.
Ich habe es leider nicht hinbekommen, mit einer Schleife, das PRoblem mit einem einzigen Code zu lösen. Hintergrund is leider die Performance, wenn ich alle 4 COdes gleichzeitig ausführen muss.
Das zweite Problem besteht darin, dass ich die Images von meinem Persönlichen Ordner auf dem Rechner lade. Ich würde gerne, dass die Images von einem anderen Sheet zwischenkopiert wird und den Blasen zugebordnet wird. ( werde ich im Code entsprechend kommentieren)
Vielen Dank für die Unterstützung im Voraus
Gruß
Hewad
'erste Reihe
Sub Image_upload_R1()
On Error Resume Next
Dim k As Integer
Dim i As Integer
Dim p As Integer
Dim sFilename As String
Dim bcontinue As Boolean
Dim spath As String
Dim strOrdner As String
Dim item_name As String
Dim fullser As FullSeriesCollection
Dim Num_bubble As Integer
Dim num_fullser As Integer
Dim bubble_order As String
Application.ScreenUpdating = False
'Pfad bestimmen
spath = Range("Main_Path")
ActiveSheet.ChartObjects("Diagramm 1").Activate
'Anzahl Serien ermitteln
num_fullser = ActiveChart.FullSeriesCollection.Count
Debug.Print varA; num_fullser
' alle Serien zurücksetzen
For k = 1 To num_fullser
ActiveChart.FullSeriesCollection(k).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 1
.Solid
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(242, 242, 242)
.Transparency = 0.9900000095
End With
Next k
Num_bubble = ActiveChart.FullSeriesCollection(1).Points.Count ' die erste Zeile Debug. _
Print varA; Num_bubble
For p = 1 To Num_bubble
'erster Treffer auf der Liste in der Zeile 62, Schleife
i = 62 'Vergleich aus der Zeile 62
bcontinue = True
While bcontinue
sFilename = ActiveSheet.Cells(i, 3).Value ' im zweiten Durchlauf steht der Wert in (i, 5) _
und so weiter
Pachage, ändern!!!
bubble_order = ActiveSheet.Cells(i, 2).Value 'im zweiten Durchlauf steht der Wert in (i, 6) _
und so weiter
If sFilename = "" Then
bcontinue = False
Else
For Each v In Array(" / ")
sFilename = Replace(sFilename, v, " ")
Next
Debug.Print varA; sFilename
item_name = spath & sFilename & ".jpg"
Debug.Print varA; item_name
Debug.Print varA; bubble_order
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.FullSeriesCollection(1).Points(bubble_order).Select
With Selection.Format.Fill
.Visible = msoTrue
.UserPicture (item_name) ' das Foto würde ich gerne von der gleichen Mappe im _
getrennten Sheet, per copy & paste übernehmen
.TextureTile = msoFalse
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
End With
i = i + 1
End If
Wend
Next p
End Sub