VBA Makro tut nicht wie es sollte

[r4mun]

Schönen guten Abend,

ich probiere jetzt schon eine Weile umher komme aber nicht weiter.

Ich möchte erreichen dass dass ich auf ein klick in ein gewisses Feld einen Namen ersetze und gleichzeitig ein Tabellenblatt das den alten eintrag trug mit den neuen Namen versehen wird.

aktueller stand ist dieser 

Code:

Sub MA1()
Dim ws As Worksheet
Dim eingabe As String
eingabe = InputBox("Bitte geben sie einen neuen Namen ein")


For Each ws In Workbooks("schicht blau 2020.xlsm").Worksheets
 If ws.Name = ActiveSheet.Range("i9") Then ws.Name = eingabe
Range("i9").Value = eingabe
 Next ws
End Sub

 wo happert es?
Ich kann den Part löschen für das benennen des WS dann ändert er korrekt den Namen der zelle,
umgekehrt lösche ich den part für den Tausch des Namens in der zelle dann benennt er das WS neu.
Beides zusammen klappt nicht.

Meine VBA kentnisse sind noch nicht allzuhoch - also hoffe ihr habt erbarmen

Grüsse

[Kuwer]

Hallo,

benutze If mit End If.

Sub m_MA1()
  Dim ws As Worksheet
  Dim eingabe As String
  
  eingabe = InputBox("Bitte geben sie einen neuen Namen ein")
  For Each ws In Workbooks("schicht blau 2020.xlsm").Worksheets
    If ws.Name = ActiveSheet.Range("i9").Value Then
      ws.Name = eingabe
      ActiveSheet.Range("i9").Value = eingabe
    End If
  Next ws
End Sub

Gruß Uwe

[Gast 123]

Hallo

@Hallo Uwe  das war Gedanken Übertragung, meine 1. Lösung war genau gleich wie deine. Dann fiel mir etwas auf ...

Warum mit For Next ein Sheet suchen, das doch als "ActiveSeet" bereits aktiviert ist???  Das ist irgendwie unsinnig!  Und ActiveSheet kann ich auch nicht gegen ws.Range("i9").Value tauschen, dann wird immer das 1. Sheet umbenannt. For Next ist somit überflüssig.  

mfg Gast 123

Code:

Sub MA1()
Dim eingabe As String
eingabe = InputBox("Bitte geben sie einen neuen Namen ein")
ActiveSheet.Range("i9").Value = eingabe
ActiveSheet.Name = eingabe
End If

[Kuwer]

Warum mit For Next ein Sheet suchen, das doch als "ActiveSeet" bereits aktiviert ist???  Das ist irgendwie unsinnig!

Es soll doch das Blatt umbenannt werden, dessen Name in der Zelle i9 des aktiven Blattes steht!

Ohne Schleife, aber mit durchgehender Fehlerbehandlung (hoffe ich), könnte es z.B. so aussehen:

Sub BlattUmbenennenKuwer()
  Dim rngZelle As Range
  Dim strAlterName As String
  Dim strNeuerName As String
  
  Set rngZelle = ActiveSheet.Range("i9")
  strAlterName = rngZelle.Value
  
  On Error Resume Next
  With Workbooks("schicht blau 2020.xlsm").Worksheets(strAlterName)
    If Err.Number = 9 Then
      MsgBox "Es gibt kein Blatt mit dem Namen """ & strAlterName & """!", vbInformation
      Err.Clear
    Else
      strNeuerName = InputBox("Bitte geben sie einen neuen Namen ein")
      'wenn etwas eingegeben und nicht abgebrochen wurde 
      If Len(strNeuerName) And Not CVar(strNeuerName) = False Then
        .Name = strNeuerName
        If Err.Number = 1004 Then
          MsgBox Err.Description, vbCritical
          Err.Clear
        Else
          rngZelle.Value = strNeuerName
          MsgBox "Das Blatt """ & strAlterName & """ wurde umbenannt in """ & strNeuerName & """.", vbInformation
        End If
      End If
    End If
  End With
  On Error GoTo 0
End Sub

Gruß Uwe

[r4mun]

boah uwe da wird mir schwindelig 

Code:

Sub m_MA1()
 Dim ws As Worksheet
 Dim eingabe As String
 
 eingabe = InputBox("Bitte geben sie einen neuen Namen ein")
 For Each ws In Workbooks("schicht blau 2020.xlsm").Worksheets
   If ws.Name = ActiveSheet.Range("i9").Value Then
     ws.Name = eingabe
     ActiveSheet.Range("i9").Value = eingabe
   End If
 Next ws
End Sub

also so tut es exakt was es soll.
Aber hast evtl ne lösung parat wie ich die Fehlermeldung bei abbruch vermeide?

[Kuwer]

Aber hast evtl ne lösung parat wie ich die Fehlermeldung bei abbruch vermeide?

ja, siehe meinen Beitrag #4.

Gruß Uwe

[r4mun]

Okay danke, "einbau" ging leichter wie gedacht. 

Danke dir vielmals klappt hervorragend.

Wenn wir da schon dabei sind - hätte ich da noch eine Frage.

Ich habe die Mappe mit einen Schreibschutz versehen.
Aktuell lauft dieses Makro.

Code:

Private Sub CommandButton2_Click()
   Dim i As Long
   Dim p1 As String
   Dim p2 As String
   p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe")
   p2 = InputBox("Bitte Passwort wiederholen!", "Passworteingabe")
   
   If p1 = "" Or p2 = "" Then
       MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!"
       Exit Sub
   End If
   
   If p1 <> p2 Then
       MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!"
       Exit Sub
   End If
   
   For i = 1 To Sheets.Count
       Sheets(i).Protect p1
   Next i
   MsgBox "alle Blätter wurden geschützt"


End Sub

Private Sub CommandButton1_Click()
Dim i As Long
Dim p1 As String
Dim p2 As String
p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe")
   If p1 = "" Then
       MsgBox "Kein Passwort eingegeben!" & vbLf & vbLf & "Blattschutz wird nicht nicht aufgehoben!"
       Exit Sub
   End If
   On Error GoTo fehler
   For i = 1 To Sheets.Count
       Sheets(i).Unprotect p1
   Next i
MsgBox "alle Blätter wurden entsperrt"

fehler:
   If Err Then MsgBox "Falsches Passwort"
End Sub

Allerdings bin ich nicht so richtig zufrieden damit.
Ich würde gerne die eingabe über eine userform lösen. In der userform ist ein togglebutton und textfeld zur eingabe enthalten. Das Passwort für den Schreibschutz kann im Code stehen da damit nur leute arbeiten die nichtmal in den Editor kommen geschweige denn das Passort finden würden.
Ist das so machbar? Da bin ich leider komplett an meiner Grenze. Verstehe meisst was die Codes machen - aber selbst bekomm ich nur einfache dinge gebacken.

[Kuwer]

Ich würde gerne die eingabe über eine userform lösen. In der userform ist ein togglebutton und textfeld zur eingabe enthalten.

Poste bitte eine Datei mit diesem Userform.

Gruß Uwe

[r4mun]

Habe mal einfach die ganze Datei angehängt.
Userform 3 ist das mit den Schreibschutz.

Das ist so die Bastel und Probierversion.

[Kuwer]

Hallo,

im Blatt "Config" hab ich die Zelle B17 zum Speichern des Ist-Zustandes gewählt. Die müsstest Du entsprechend entsperren.

Der Code im Userform mit Toggle-Steuerung:

Private Sub ToggleButton1_Click()
    Dim oWs As Worksheet
    
    If ToggleButton1.Tag = "" Then
      ToggleButton1.Tag = 1
    Else
      If Len(TextBox1.Text) = 0 Then
        MsgBox "Kein Passwort eingegeben!"
        ToggleButton1.Tag = ""
        ToggleButton1.Value = Not ToggleButton1.Value
        TextBox1.SetFocus
      Else
        If TextBox1.Text = "yxc" Then
          On Error Resume Next
          For Each oWs In Worksheets
            If ToggleButton1 Then
              oWs.Protect TextBox1.Text
            Else
              oWs.Unprotect TextBox1.Text
            End If
          Next oWs
          If Err.Number = 0 Then
            Worksheets("Config").Range("B17").Value = ToggleButton1.Value
          Else
            MsgBox "Hinterlegtes Passwort vermutlich falsch!"
            ToggleButton1.Tag = ""
            ToggleButton1.Value = Not ToggleButton1.Value
            TextBox1.SetFocus
            Err.Clear
          End If
          On Error GoTo 0
        Else
          MsgBox "Eingegebenes Passwort ist falsch!"
          ToggleButton1.Tag = ""
          ToggleButton1.Value = Not ToggleButton1.Value
          TextBox1.SetFocus
        End If
      End If
    End If
End Sub

Private Sub UserForm_Activate()
  ToggleButton1.Value = Worksheets("Config").Range("B17").Value
  ToggleButton1.Tag = 1
End Sub

Gruß Uwe