AW: Sortieren die zweite
31.07.2003 21:00:11
Nepumuk
Hallo Silke,
ich schon wieder.
Anleitung:
1. Lösche den alten Code aus dem Klassenmodul der Tabelle und kehre wieder zur Tabelle zurück.
2. Mach einen Rechtsklick auf das Excelicon in der Menüleiste. (Links neben Datei, Bearbeiten.....). Klicke auf "Code anzeigen".
3. In das sich öffnende Editorfenster kopierst du folgenden Code:
Option Explicit
Private Sub Workbook_Open()
start
End Sub
4. Bleib im VBA - Editor, klicke in der Menüleiste auf Einfügen und wähle Modul aus.
5. Kopiere in das Editorfenster folgenden Code:
Option Explicit
Public Sub start()
Dim MenüLeiste As CommandBar, neuesMenü As CommandBarControl
On Error Resume Next
Do
Application.CommandBars("Worksheet Menu Bar").Controls("Eingeben").Delete
Loop Until Err.Number <> 0
On Error GoTo 0
Set MenüLeiste = CommandBars.ActiveMenuBar
Set neuesMenü = MenüLeiste.Controls.Add(Type:=msoControlButton, Temporary:=True)
neuesMenü.Caption = "Eingeben"
neuesMenü.OnAction = "Eingeben"
neuesMenü.Style = msoButtonCaption
neuesMenü.Visible = True
End Sub
Private Sub Eingeben()
Dim englisch As String, deutsch As String
Do
englisch = InputBox("Bitte die englische Vokable eingeben.", "Eingabe")
If Trim(englisch) = "" Then Exit Do
deutsch = InputBox("Bitte die deutsche Übersetzung für " & Chr(34) & englisch & Chr(34) & " eingeben.", "Eingabe")
If Trim(deutsch) = "" Then Exit Do
ActiveSheet.Unprotect
Cells(65536, 1).End(xlUp).Offset(1, 0) = englisch
Cells(65536, 4).End(xlUp).Offset(1, 0) = englisch
Cells(65536, 2).End(xlUp).Offset(1, 0) = deutsch
Cells(65536, 3).End(xlUp).Offset(1, 0) = deutsch
Range("A2:B65536").Sort Key1:=Range("A2")
Range("C2:D65536").Sort Key1:=Range("C2")
ActiveSheet.Protect
Loop
End Sub
6. Speichere die Mappe und schließe sie.
7. Öffne die Mappe wieder.
Jetzt findest du in der Menüleiste einen neuen Eintrag "Eingeben". Ein Klick darauf startet das Eingabeprogramm. Zum beenden des Programms einfach in die Inputbox nichts eingeben und Enter drücken, oder auf Abbrechen klicken.
Viel Erfolg beim lernen wünscht
Nepumuk