Der Teil, welcher die Bildpositionen setzt.
Sub BPSetzen(bereichName)
Dim rngIndex As Integer
Dim rngPosPic As Range
Set rngPosPic = ThisWorkbook.Sheets("Options").Range("Tab_Grafiken")
Dim Options As Worksheet
Dim Greiferdaten As Worksheet
Dim topBereich As Double
Dim topM As Double
Dim leftBereich As Double
Dim leftM As Double
Dim width As Double
Dim height As Double
Dim sZeilen As Integer
Set Options = ThisWorkbook.Sheets("Options")
Set Greiferdaten = ThisWorkbook.Sheets("Greiferdaten")
For rngIndex = 1 To rngPosPic.Rows.Count
Dim bbName As String
With Options
bbName = "B_" & .Range("Tab_Grafiken[Bereichname]").Cells(rngIndex, 1).Value
End With
If LCase(bereichName) = LCase(bbName) Or bereichName = "" Then
With Greiferdaten
topBereich = .Range(bbName).top
topM = topBereich + CDbl(Options.Range("Tab_Grafiken[Y]").Cells(rngIndex, 1).Value)
leftBereich = .Range(bbName).Left
leftM = leftBereich + CDbl(Options.Range("Tab_Grafiken[X]").Cells(rngIndex, 1).Value)
width = CDbl(Options.Range("Tab_Grafiken[Width]").Cells(rngIndex, 1).Value)
height = CDbl(Options.Range("Tab_Grafiken[Height]").Cells(rngIndex, 1).Value)
Dim shapeName As String
shapeName = Options.Range("Tab_Grafiken[Kopierter Name]").Cells(rngIndex, 1).Value
If Not ShapeExists(Greiferdaten, shapeName) Then
MsgBox "Shape nicht gefunden. """ & shapeName & """"
GoTo Continue
End If
With .shapes(shapeName)
.Placement = xlFreeFloating
If AlleAnzeigen Then
.Visible = True
End If
.top = topM
.Left = leftM
.width = width
.height = height
.Rotation = CDbl(Options.Range("Tab_Grafiken[Rotation]").Cells(rngIndex, 1).Value)
End With
End With
End If
Continue:
Next rngIndex
End Sub