Servus!
Ich habe ein Problem:
Ich habe mit meinem seichten Halbwissen ein excelmakro geschrieben, welches verschiedene Zelleninhalte auf eine Powerpointfolie kopiert,
ich erhalte aber manchmal (!!!) den oben genannten Fehler mit dem Zusatz "Der angegebene Wert liegt außerhalb des Zulässigen Bereichs"...und zwar immer in den Zeilen mit den Paste funktionen (sind 2), aber ohne Regelmäßigkeit!
Das erstaunliche ist, dass das nicht immer der Fall ist, sprich, das makro läuft durch!
Wie kann ich das beheben, so dass das Makro in jeder Office (2007) läuft? habe Win XP und Office 2007
Sub test_einzelzellen()
Dim PPT As PowerPoint.Application
Dim Slide As PowerPoint.Slide
Dim Count As Integer
Dim zeilen As Integer
Dim IntCounter As Integer
Dim n As Integer
Dim nSpalte As Integer
Set PPT = New PowerPoint.Application 'öffne PowerPoint
With PPT
.Visible = True
.Presentations.Add
.Presentations(1).Slides.Add(1, ppLayoutBlank).Select
End With
'Count = PPT.Presentations.Slides.count
'MsgBox "Zeilenanzahlt:" & zeilen, vbOKOnly '
'MsgBox Count
Range("A1").Select 'Zählen der Zeilen des Excel, damit die Schleife irgendwann aufhört!
zeilen = Selection.CurrentRegion.Rows.Count
IntCounter = zeilen
n = zeilen
nSpalte = 2
Do Until IntCounter = 1
PPT.Presentations(1).Slides.Add(1, ppLayoutBlank).Select
Set Slide = PPT.ActivePresentation.Slides(1)
Do Until nSpalte = 10
Cells(n, nSpalte).Select
Selection.Copy
With Slide.Shapes _
.AddShape(msoShapeRectangle, 200, 70 + 40 * nSpalte, 300, 20).TextFrame 'Zellenwerte einfügen/shapes(also textfelder) vorher erzeugt
.TextRange.Paste
.TextRange.Font.Size = 15
.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextRange.Font.Color = black
End With
With PPT.ActivePresentation.Slides(1).Shapes(nSpalte - 1) ' Textfeld transparent...
.Fill.Visible = msoFalse
.Line.Visible = msoCFalse
End With
nSpalte = nSpalte + 1
Loop
With Slide.Shapes _
.AddShape(msoShapeRectangle, 0, 0, 300, 20).TextFrame ' Wort "Datenblatt" eingefügt und postiert
.TextRange.Text = "Datenblatt"
.TextRange.Font.Size = 45
.TextRange.ParagraphFormat.Alignment = ppAlignCenter
.TextRange.Font.Color = black
End With
With PPT.ActivePresentation.Slides(1).Shapes(nSpalte - 1)
.Fill.Visible = msoFalse
.Line.Visible = msoCFalse
.Left = 220
.Top = 50
End With
Dim nZeile1 As Integer 'hier sollen jetzt die Standartbezeichner rein (also "Hersteller" usw)
nZeile1 = 2
Do Until nZeile1 = nSpalte
Cells(1, nZeile1).Select
Selection.Copy
With Slide.Shapes _
.AddShape(msoShapeRectangle, 20, 70 + 40 * nZeile1, 250, 20).TextFrame
.TextRange.Text = .TextRange.Paste & " :"
.TextRange.Font.Size = 15
.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextRange.Font.Color = black
End With
With PPT.ActivePresentation.Slides(1).Shapes(nSpalte + nZeile1 - 2)
.Fill.Visible = msoFalse
.Line.Visible = msoCFalse
End With
nZeile1 = nZeile1 + 1
Loop
nSpalte = 2 ' Spalte rücksetzen
IntCounter = IntCounter - 1 'zeilen zähler für aktuelle Position/ Zeile
n = n - 1 ' n erhöhen, damit es eine zeile weitergeht
Loop
MsgBox "Fertig"
End Sub
|