mal wieder makros

serv @all,

weis net ob das hier her gehört! schreit wenns falsch ist!

diese makro läuft bei mir net.

ich habe von dem ganzen keine ahnung wird wahrscheinlich ziemlich leicht gehen es zum laufen zu bringen. wenn man weis wies geht!

getestet auf office 2003 und 2002.

code:

Option Explicit

Private Const DONT_SHOW = (
Private Const CELL_PAPER_TYPE = C3
Private Const CELL_COL_FIRST_DATE = 2
Private Const LIST_HEIGHT = 300
Private Const INDEX_NAME = 1
Private Const INDEX_TYPE = 2

Sub DisplaySheet(SheetName As String)
On Error GoTo SheetError
Dim LastRow As Integer
   
   Sheets(SheetName).Select
   LastRow = ActiveSheet.Cells(Rows.Count, CELL_COL_FIRST_DATE).End(xlUp).Row + 1
   ActiveSheet.Cells(LastRow, CELL_COL_FIRST_DATE).Select
         
SheetError:
End Sub

Sub GoToMenu()
    Menu.Select
End Sub

Sub Initialize()
Dim Sheet As Worksheet
Dim SheetNameArray() As String
Dim Index As Integer
   
   Menu.SheetList.Clear
   Menu.SheetList.ColumnCount = 2
   Menu.SheetList.ColumnWidths = 60;
   
   ReDim SheetNameArray(1 To Sheets.Count - GetNoShowCount, 1 To 2)
   
   Index = 1
   For Each Sheet In Sheets
      If Left(Sheet.Name, 1) <> DONT_SHOW Then
         SheetNameArray(Index, INDEX_NAME) = Sheet.Name
         SheetNameArray(Index, INDEX_TYPE) = Sheet.Range(CELL_PAPER_TYPE).Text
         Index = Index + 1
      End If
   Next
   
   Sort2D SheetNameArray
   
   Menu.SheetList.List() = SheetNameArray()
   Menu.SheetList.Height = LIST_HEIGHT
End Sub
Sub Neu()
'
' Neu Makro
' Makro am 11.08.2003 von * aufgezeichnet
'

'
Dim Mldg, Titel, Voreinstellung, Wert1
Mldg = Nummer
Titel = Nummer eingeben
Voreinstellung = 9999
Wert1 = InputBox(Mldg, Titel, Voreinstellung)
If Wert1 = Then Exit Sub
ActiveWorkbook.Worksheets((Papier_Basis)).Copy Before:=Worksheets((Papier_Basis))
ActiveSheet.Name = Wert1

End Sub


Private Function GetNoShowCount() As Integer
Dim Sheet As Worksheet
   
   GetNoShowCount = 0
   For Each Sheet In Sheets
      If Left(Sheet.Name, 1) = DONT_SHOW Then
         GetNoShowCount = GetNoShowCount + 1
      End If
   Next
End Function

Private Sub Sort2D(ByRef AnArray)
Dim Index As Integer
Dim Temp() As String
Dim SwapCount As Integer

SwapCount = 1
Do Until SwapCount = 0
    SwapCount = 0
    For Index = 1 To UBound(AnArray) - 1
        If AnArray(Index, INDEX_NAME) > AnArray(Index + 1, INDEX_NAME) Then
            Temp() = AnArray(Index + 1)
            AnArray(Index + 1) = AnArray(Index)
            AnArray(Index) = Temp()
            SwapCount = SwapCount + 1
        End If
    Next
Loop
End Sub

:code

Hi pengo,

bei Menu.SheetList bin ich etwas ratlos. Hab das einfach durch eine Userform->Userform1' und eine daraufliegende Listbox->Listbox1' ersetzt.
Mit den dann vorgenommenen Änderungen gibt das Makro Initialize dann die Liste der Tabellenblätter und den Inhalt von C3 des jeweiligen tabellenblattes aus.

Das eigentliche Problem ist in Sort2D das Feld Temp(). Das wird jetzt entsprechend dimensioniert und übergeben.

Ein Weiteres Problem liegt in der Zuweisung Menu.SheetList.List() = SheetNameArray(). Hier Muß der Typ von SheetNameArray auf Variant geändert werden, weil Listenfelder eben diesen Typ erwarten.

Gruß Matjes

erst mal thx !

jetzt sieht schon besser aus jedoch wenn ich jetzt ne eingabe macht
und bestädige

sagt er index auserhalb des bereichs

und springt dann zu der zeile ?

[sub]
ActiveWorkbook.Worksheets((Papier_Basis)).Copy Before:=Worksheets((Papier_Basis))[/sub]

Das heißt zu deutsch:
Es gibt in der Mappe kein Blatt mit dem Namen (mit Klammern ).
Das wird aber erwartet 

Gruß Matjes