Guten Morgen,
ich habe mein Programm soweit fertig geschrieben und stehe nun vor einem mir unerklärbarem Problem.
Mein Programm enthält Bilder, welche sich bei bestimmten Maßen ändern, aber deren Platzierung ist immer gleich.
Bei mir auf dem Laptop bzw. Monitor der am Laptop angeschlossen ist bleiben die Bilder wie gewünscht an der gleichen Stelle, jedoch wenn ich die Datei an den Arbeitsplätzen meiner Arbeitskollegen öffne, dann ist das Bild nicht mehr an der selben Stelle.
Das Programm wurde in Excel 2013 geschrieben und die Arbeitskollegen haben auch Excel 2013.
Bildschirmauflösung ist bei allen die selbe: 1920 x 1080.
Hier noch mal ein Teil meines Codes:
Dim s As Shape
On Error Resume Next
With ActiveSheet
.Shapes("Halter_2").Delete
.Shapes("Halter_3").Delete
.Shapes("Halter_4").Delete
.Shapes("Halter_5").Delete
.Range("A12:L35").ClearContents
End With
On Error GoTo 0
If Tabelle4.Range("F49").Value = dicke26 Then
Select Case Range("F47")
Case 0 To 1500
Set s = Tabelle2.Shapes("Halter_2")
Call BildAktualisieren1500
Case 1501 To 2200
Set s = Tabelle2.Shapes("Halter_3")
Call BildAktualisieren2200
Case 2201 To 2900
Set s = Tabelle2.Shapes("Halter_4")
Call BildAktualisieren2900
Case 2901 To 3700
Set s = Tabelle2.Shapes("Halter_5")
Call BildAktualisieren3700
Case 3701
MsgBox ("Alles über 3700mm und 2x6 ist Sondermaß!")
End Select
ElseIf Tabelle4.Range("F49").Value = dicke28 Then
Select Case Range("F47")
Case 0 To 1700
Set s = Tabelle2.Shapes("Halter_2")
Call BildAktualisieren1700
Case 1701 To 2800
Set s = Tabelle2.Shapes("Halter_3")
Call BildAktualisieren2800
Case 2801 To 3900
Set s = Tabelle2.Shapes("Halter_4")
Call BildAktualisieren3900
Case 3901 To 5000
Set s = Tabelle2.Shapes("Halter_5")
Call BildAktualisieren5000
Case 5001
MsgBox ("Alles über 5000mm und 2x8 ist Sondermaß!")
End Select
ElseIf Tabelle4.Range("F49").Value = dicke210 Then
Select Case Range("F47")
Case 0 To 2000
Set s = Tabelle2.Shapes("Halter_2")
Call BildAktualisieren2000
Case 2001 To 3400
Set s = Tabelle2.Shapes("Halter_3")
Call BildAktualisieren3400
Case 3401 To 4800
Set s = Tabelle2.Shapes("Halter_4")
Call BildAktualisieren4800
Case 4801 To 6200
Set s = Tabelle2.Shapes("Halter_5")
Call BildAktualisieren6200
Case 6201
MsgBox ("Alles über 6200mm und 2x10 ist Sondermaß!")
End Select
End If
If Not s Is Nothing Then
s.Copy
ActiveSheet.Paste
With Selection
.Top = Rows(13).Top
.Left = Columns(1.5).Left
End With
End If
Ich bedanke mich Voraus.
Beste Grüße
Daniel