Private
Sub
Worksheet_Calculate()
Dim
Picture
As
Shape
Application.ScreenUpdating =
False
Sheets(
"Expert-Modus"
).Range(
"E50"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"G49:I51"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J49:L51"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J55:L58"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J62:L65"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J69:L72"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J76:L79"
).ClearContents
Sheets(
"Expert-Modus"
).Range(
"J83:L86"
).ClearContents
For
Each
Picture
In
Sheets(
"Expert-Modus"
).Shapes
If
Picture.Type = 13
Then
With
Picture
.Delete
End
With
End
If
Next
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"E95"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"E50"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"G95"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"G49:I51"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J95"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J49:L51"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J96"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J55:L58"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J97"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J62:L65"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J98"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J69:L72"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J99"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J76:L79"
).PasteSpecial Paste:=xlPasteValues
Sheets(
"Bilder"
).Shapes(Sheets(
"Expert-Modus"
).Range(
"J100"
)).Copy
Sheets(
"Expert-Modus"
).Range(
"J83:L86"
).PasteSpecial Paste:=xlPasteValues
With
Selection
.ShapeRange.LockAspectRatio =
False
.ShapeRange.Height = 500
.ShapeRange.Width = 1000
.ShapeRange.Left = 350
.ShapeRange.Top = 0
End
With
Exit
Sub