Index außerhalb des gültigen Bereichs
27.08.2007 09:21:18
HalMar
bei folgendem Makro erhalte ich in der markierten Zeile den Fehler "Index außerhalb des gültigen Bereichs". Genau öffnet das Programm eine Excel Datei (variabel), fragt den Zeilenbereich ab, der kopiert werden soll, und kopiert dann alle vorhandenen Reihen im Zeilenbereich auf das Ausgangsblatt (fix, benannt), aktiviert es aber nicht. Anschließend wird das offene Dokument geschlossen und das fixe aktiviert. Ich hoffe ihr findet den Fehler ;)
Sub datei_öffnen()
Dim DateiName As String
Dim Myunion As Range, Range1, Range2, Markierung As String
Dim Checkcount As Long
Dim Enter As Integer
Dim Zahl1, Zahl2 As Integer
Zahl1 = ActiveSheet.Range("B1")
Zahl2 = ActiveSheet.Range("C1")
Dim Bereich1, Bereich2 As Integer
DateiName = Application.GetOpenFilename("Excelfiles (*.xls), *.xls", Title:="Datei auswählen", _
_
_
MultiSelect:=False)
Select Case DateiName
Case "Falsch"
MsgBox "Es wurde keine Datei ausgewählt."
Case Else
Workbooks.Open DateiName
ActiveSheet.Select
Enter = InputBox("Bei welcher Zeile beginnt Ihre Tabelle? (Überschriftenzeile _
eingerechnet, Eingabe nur in Zahlen möglich)")
Bereich1 = InputBox("In welcher Zeile fängt der Tabellenabschnitt, den Sie übertragen mö _
_
chten, an?")
Bereich2 = InputBox("In welcher Zeile hört der Tabellenabschnitt, den Sie übertragen mö _
_
chten, auf?")
For Checkcount = 0 To 2
If Len(Markierung) > 0 Then Markierung = Markierung & ","
Markierung = Markierung & Chr(65 + Checkcount) & Enter & "," & Chr(65 + Checkcount) _
_
& Bereich1 & ":" & Chr(65 + Checkcount) & Bereich2
Next Checkcount
Range(Markierung).Copy
ThisWorkbook.Sheets("Diagcreator").Range("A5").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("Diagcreator").Range("A5").PasteSpecial Paste:=xlPasteFormats _
_
i>
Application.CutCopyMode = False
ActiveWorkbook.Close (False)
On Error GoTo 1
End Select
Dim Sel As Integer, Colcount As Integer
Application.ScreenUpdating = False
Colcount = ActiveSheet.UsedRange.Columns.Count
For Sel = 0 To Colcount - 2
Range("B2").Select
ActiveCell.Offset(0, Sel).Select
If Selection.Value = "" Then
If Sel = 0 Then
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=True, _
DisplayAsIcon:=False, Left:=100, Top:=14, Width:=11, Height:=11). _
Select
Else
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=True, _
DisplayAsIcon:=False, Left:=100 + (60 * Sel), Top:=14, Width:=11, Height:=11). _
Select
End If
End If
On Error GoTo 1
Next Sel
Application.ScreenUpdating = True
1:
End Sub
Lg, Mario