VBA läuft nur ohne Dockingstation richtig
25.10.2017 08:19:03
ZD14
Ich habe bei meinem Code etwas sehr sehr sehr sehr seltsames entdeckt und weiß nicht mehr weiter!
Ich habe ein VBA-Modul geschrieben, welches benannte Bereiche aus Excel in eine PowerPoint-Präsentation einfügt. Das habe ich nun einem Kollege in Amerika geschickt. Beim Testlauf ist folgendes passiert:
- hier (am europäischen Standort) funktioniert alles reibungslos bei 7 verschiedenen PCs auf mehreren Office-Versionen etc.
- in Amerika funktioniert der Code nur richtig, wenn der Laptop nicht mit der Dockingstation verbunden ist! Es kommt keine Fehlermeldung. Der Unterschied ist, dass mit Dockingstation die Bereiche zugeschnitten werden (d.h. es ist nicht mehr alles sichtbar). Ohne Dockingstation wird der gesamte Bereich kopiert und richtig eingefügt!
Ich blick wirklich nicht durch! Wie kann die Dockingstation meinen Code beeinflussen? :O Vor allem, da das hier keinen Unterschied macht!
Bin dankbar für jede Hilfe. :)
Der betroffene Code-Abschnitt (ich könnte mir nicht erklären, wo der Fehler sonst liegen soll)
'oPPT = Powerpoint Presentation
'sng = Single --> Werte geben Position des Bildes an
For int_j = int_x To 5 'increase to add more ranges
'Copy ranges
'insert in powerpoint
'set position in the slide's centre (except int_j = 1 --> Financial Assumptions)
DoEvents
'Set range and position
If int_j = 1 Then
ActiveWorkbook.Sheets("PM-DB").Range("rng_Sheeta-2").Copy
sng_Left = 19.8425
sng_Height = 260.7874
End If
If int_j = 2 Then
ActiveWorkbook.Sheets("PM-DB").Range("rng_Sheeta-1").Copy
sng_Left = 34.86614
sng_Height = 311.811
End If
If int_j = 3 Then
ActiveWorkbook.Sheets("PBU").Range("rng_Sheetb-1").Copy
sng_Left = 142.8661
sng_Height = 311.811
End If
bln_grouped = Grouped
If int_j = 4 Then
ActiveWorkbook.Sheets("Sheetc").Outline.ShowLevels ColumnLevels:=1
sng_Left = 87.874
sng_Height = 311.811
ActiveWorkbook.Sheets("Sheetc").Range("rng_Sheetc-1").Copy
End If
If int_j = 5 Then
ActiveWorkbook.Sheets("Sheetc").Outline.ShowLevels ColumnLevels:=1
sng_Left = 30.04724
sng_Height = 311.811
ActiveWorkbook.Sheets("Sheetc").Range("rng_Sheetc-2").Copy
End If
oPPT.ActivePresentation.Slides(int_j).Select
'insert range as bitmap
int_i = oPPT.ActivePresentation.Slides(int_j).Shapes.Count 'shape count on slides --> _
prevents deleting the title
If int_i > 1 Then
oPPT.ActivePresentation.Slides(int_j).Shapes.PasteSpecial(DataType:=xlBitmap). _
Select
With oPPT.ActivePresentation.Slides(int_j).Shapes(int_i + 1)
.Height = sng_Height
.Left = sng_Left
.Top = 72
End With
If Not int_j = 1 Then sng_Left = (680.315 - oPPT.ActivePresentation.Slides(int_j). _
Shapes(int_i + 1).Width) / 2 + 19.8425
With oPPT.ActivePresentation.Slides(int_j).Shapes(int_i + 1)
.Left = sng_Left
End With
Else
oPPT.ActivePresentation.Slides(int_j).Shapes.PasteSpecial(DataType:=xlBitmap). _
Select
With oPPT.ActivePresentation.Slides(int_j).Shapes(2)
.Height = sng_Height
.Left = sng_Left
.Top = 72
End With
If Not int_j = 1 Then sng_Left = (680.315 - oPPT.ActivePresentation.Slides(int_j). _
Shapes(2).Width) / 2 + 19.8425
With oPPT.ActivePresentation.Slides(int_j).Shapes(2)
.Left = sng_Left
End With
End If
Next int_j