VB-Script und Excel Button

[Jörg]

Hi,

das sieht doch schon mal gut aus.

Danke auch dir für die gute Hilfe.
Ich muss demnächst wirklich mal in VBS reinlesen. Kann man so geile Sachen machen und ich hab nicht so richtig Plan davon. Naja.

Ja, damit kann man schon feine Sachen machen, vor allem sich viel Zeit sparen. ;-)

Sub CommandButton1_Click()
   Dim Traegername As String
   Traegername = InputBox("Wie heißt der Traeger?")

Bis hierher ist es richtig, und hier meckert er zu Recht:

ThisWorkbook.Worksheets("Haupt").Copy Worksheets("Haupt") After:=Worksheets("Sheet3")

Du hast zwar das zweite Copy gelöscht, aber nicht das, was dazugehörte. Etwas ist noch doppelt. ;-)

Das stimmt wieder:

ActiveSheet.name = Traegername
End Sub

Bei der vorletzen Zeil meckert er jetzt noch rum. Hab "Position" rausgenommen und das zwei "Copy" gelöscht. Ist sicher nochn kleiner Fehler drinne. Falls dat irgendwann funktioniert mach ich glaub ich Luftsprünge :)

Naja, wenn der Code läuft, ist er aber noch nicht fertig. Normalerweise müssen da noch Prüfungen rein, zum Beispiel ob schon eiin Blatt mit dem Namen vorhanden ist, ob es das Blatt Haupt überhaupt gibt, usw.

Kannst Dir ja mal den Code ansehen:

Sub CommandButton1_Click()  
Dim Traegername As String  
Dim objBlatt As Object  
Dim strQuellBlatt As String  
  
strQuellBlatt = "Haupt"  
  
'Prüfen, ob das zu kopierende Blatt vorhanden ist  
On Error GoTo FEHLER  
Set objBlatt = ThisWorkbook.Sheets(strQuellBlatt)  
On Error GoTo 0  
  
'Blattnamen erfragen:  
Traegername = Application.InputBox("Wie heißt der Traeger?", "Name", Traegername)  
  
'Prüfen, ob eine Eingabe erfolgte, wenn nicht, abbrechen:  
If Traegername = "" Then Exit Sub  
  
'Prüfen, ob der Name zu lang ist:  
If Len(Traegername) > 31 Then  
    MsgBox "Der Name ist zu lang, er darf nicht mehr als 31 Zeichen enthalten.", vbOKOnly + vbExclamation, "Schwerer Ausnahmefehler"  
    Exit Sub  
End If  
  
'Prüfen, ob ein ungültiges Zeichen enthalten ist:  
If Traegername Like "*[:\/?*[]*" Or Traegername Like "*]*" Then  
    MsgBox "Im Namen ist ein ungültiges Zeichen enthalten.", vbOKOnly + vbExclamation, "Computerabsturz"  
    Exit Sub  
End If  
  
'Prüfen, ob ein Blatt mit dem eingegebenen Namen bereits exisitiert:  
'Jedes Blatt der Mappe prüfen:  
For Each objBlatt In ThisWorkbook.Sheets  
    'Wenn das gerade geprüfte Blatt den eingegebenen Namen hat:  
    If objBlatt.Name = Traegername Then  
        'Meldung bringen:  
        MsgBox "Ein Blatt mit diesem Namen existiert bereits.", vbOKOnly + vbExclamation, "Allgemeine Schutzverletzung"  
        'Routine verlassen:  
        Exit Sub  
    End If  
Next  
  
'Blatt "Haupt" hinter das Blatt "Sheet3" kopieren:  
ThisWorkbook.Worksheets(strQuellBlatt).Copy After:=ThisWorkbook.Worksheets("Sheet3")  
  
'Das neue Blatt mit dem Namen versehen:  
ActiveSheet.Name = Traegername  
  
'Geschafft.  
Set objBlatt = Nothing  
Exit Sub  
  
FEHLER:  
MsgBox "Fehler: Das zu kopierende Blatt " & strQuellBlatt & " existiert nicht.", vbOKOnly + vbCritical, "Schwerer Verlust"  
End Sub

Viele Grüße

Jörg