In Excel Makros aus aktiven Sheet löschen?

Ich Möchte ein Tabellenblatt neben das Original kopieren, in dem man nichts mehr ändern kann, aber anschliesssend die Sub Makros aus der Kopie Löschen, da sonnst die Datie zu groß wird. Das Kopieren funktioniert super, nur mit den Makros entfernen noch nicht so.

Das ist mein Code zum Kopieren, Danke

Sub NeuesTabBlatt()
' Monate Soll
 If MsgBox("Wollen Sie wirklich einen neuen Sollplan erstellen?", vbYesNo) = vbYes Then
 If InputBox("geben sie Bitte das Passwort zum Entsperren ein", "  Sollplanerstellung") = "1234" Then
        MsgBox "OK, der Sollplan wird erstellt"
 Else
 MsgBox "Hier kommst Du net rein!"
 ActiveSheet.Range("$A$1").Select
 Exit Sub
 End If
Application.ScreenUpdating = False
Application.Calculation = False
Dim NewName As String
ActiveWorkbook.Unprotect Password:="1234"
NewName = ActiveSheet.Range("$CW$1")
ActiveSheet.Copy After:=ActiveSheet
 ActiveSheet.Name = "Soll" & " " & ActiveSheet.Range("CW1")
  ActiveSheet.Range("AT127:AV134,AQ133:AS133, AT183:AV186, AT228:AV232").Clear
       ZeilenEinUndAusblenden
    ActiveSheet.EnableSelection = xlNoSelection
   ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.Visible = False
  ActiveWorkbook.Protect "1234", Structure:=True
  Application.Calculation = xlAutomatic
 Application.ScreenUpdating = True
 MsgBox "ein neues SOLL Tabellenblatt wurde erstellt"
 End If
 'BlätterSollEinAus
 ActiveSheet.Range("$A$1").Select
End Sub

2 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

04.10.2022, 20:35

Entferne das Makro vom Tabellenblatt selbst und packe es in ein Modul.
Dann rufe das Makro nur auf wenn es das neue Tabellenblatt braucht. ggf über eine Tastenkombination, oder zufügen im Menu, oder einem separaten Knopf irgendwo.
..
Hier wird erklärt wie man per Code Module löschen kann.
per VBA alle Module löschen (office-hilfe.com)
Ob dies analog auch Code anwendbar ist, der sich "am Blatt" befindet, gilt es zu testen.

Baumhaus65

Beitragsersteller

04.10.2022, 21:42

Das geht glaube nicht so einfach, da ich einige

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

und

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

verbaut habe

IchMalWiederXY

04.10.2022, 21:44

@Baumhaus65

mmhh. Einfach per Makro Code löschen, oder das Verschieben des bisherigen Code in ein Modul ? Letzteres hat keinen Einfluss auf anderen Code.

Baumhaus65

Beitragsersteller

04.10.2022, 21:47

@IchMalWiederXY

Ich habe ein Dienstplan erstellt, und Da wird immer ein Sollplan gespeichert, der nicht verändert werden darf. Am anfang des Jahres ist der Plan ca 4,5 Mb groß und am ende des Jahres 11Mb. Das ist sehr viel, und ich weis nicht, ob mir das der Server und die Admins mal übel nehmen. einfach per Makro löschen währe glaube ich die beste lösung. Ich kenne aber nur eine, die alle Macros löscht, und nicht nur die im aktuellen sheet

IchMalWiederXY

04.10.2022, 21:51

@Baumhaus65

Wenn sie euch dies mit Excel machen lassen anstatt einem Tool dass dafür geeignet ist selbst Schuld. ABER.
Dein Code der dann ins Modul verschoben ist. Wird dabei NIE MEHR verdoppeln.
Sondern NUR deine Vorlagen Seite, dies sich im Hintergrund befindet für einen weiteren Monat vervielfältigt und sichtbar.
..ist auch eine Lösung, die ich für diverse Excel Lösungen umgesetzt habe.
11MB ist am Ende auch nicht wirklich "groß".
Meine schlimmste Excel hat ~320MByte. (Macht aber auch keinen Spaß mehr, diese zu verwenden.)

Baumhaus65

Beitragsersteller

04.10.2022, 21:53

@IchMalWiederXY

Kannst du mir da ein bischen auf die Sprünge helfen, wie ich das anstellen kann

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

04.10.2022, 22:04

Zunächst den Code, der sich am Blatt befindet:

Bild zum Beitrag

in ein Modul verschieben
Hierfür im Projekt Explorer "rechte maus" klicken und "Modul Einfügen" wählen.
Dann den Code per Strg+x aus der tabelle herauskopieren und im Modul pasten

Bild zum Beitrag

Anschließend könntest du auf deiner Vorlage einen Knopf anbringen.
Dies ist ein abgerundetes Rechteck, das man zum "knopf" umgestallten kann, um dann letztlich auch DEIN Makro zuzuweisen.

Bild zum Beitrag

Ist dieser Knopf auf deiner Vorlage vorhanden wird NUR der Knopf ebenfalls kopiert. Diesen kannst du dann anschließend auf dem neuen Blatt löschen.
ABER hierbei ACHTUNG, dass du das MAKRO NICHT erneut auslöst.
Also mit rechter Maus markieren und entfern drücken.
(Oder per VBA Code, diesen button (ist ein Shape) löschen.)

Baumhaus65

Beitragsersteller

04.10.2022, 22:13

Ok, das werde ich versuchen, wird wohl ne weile dauern, bis ich dir schreiben kann ob es funktioniert. Ich habe mir das einfacher vor gestellt.

Ich Danke dir für deine Bemühungen

IchMalWiederXY

04.10.2022, 22:15

@Baumhaus65

Es ist "einfach". Dein Code existiert ja schon. Er wird nur im einem Modul ausgeführt. ..nicht vom ungewohnten irritieren lassen. Viel Erfolg

Ähnliche Beiträge

Excel VBA Blattschutz Passwort umgangen?

Hallo,

Ich habe folgendes Problem.

Ich habe einen Button mit dem man den Blattschutz de/aktivieren kann.

Jedoch kann man das PW umgehen, indem man einfach das Fenster schliest, indem man das PW eingibt.

Hat da jemand eine ahnung, wie ich das ausbessern kann?

Macro:

Private Sub CommandButton1_Click()

If MsgBox("Blattschutz aufheben/aktivieren?", vbYesNo) = vbYes Then

Else: Exit Sub

[...Aktion ausführen...]

End If

On Error GoTo PW

If ActiveSheet.ProtectContents = True Then

ActiveSheet.Unprotect

' einblenden:

ActiveWindow.DisplayHeadings = True

Else

ActiveSheet.Protect Password:="+1516", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True

' ausblenden:

ActiveWindow.DisplayHeadings = False

End If

Exit Sub

PW:

MsgBox "Falsches Passwort"

End Sub

...zum Beitrag

Wie kann ich Kontrollkästchen elegant miteinander verknüpfen, um nach mehreren Kriterien zu filtern?

Hallo zusammen,

in einer ExcelDatei befinden sich Formularsteuerlemente bzw. 3 Kontrollkästchen mit denen ich verschiedene Kriterien nach Hunde, Katzen und Vögel filtern sowie verknüpfen möchte.

Mit ActiveX-Steuerelemente Kontrollstästchen und CommandButton konnte ich folgendes Beispiel aufbauen:

Private Sub ausführen_Click()

    If CheckBox1.Value = True And CheckBox2.Value = False And CheckBox3.Value = False Then
        Hund
    ElseIf CheckBox1.Value = False And CheckBox2.Value = True And CheckBox3.Value = False Then
        Katze
    ElseIf CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = True Then
        Vogel
    ElseIf CheckBox1.Value = True And CheckBox2.Value = True And CheckBox3.Value = False Then
        HundKatze
    ElseIf CheckBox1.Value = False And CheckBox2.Value = True And CheckBox3.Value = True Then
        KatzeVogel
    ElseIf CheckBox1.Value = True And CheckBox2.Value = False And CheckBox3.Value = True Then
        HundVogel
    ElseIf CheckBox1.Value = True And CheckBox2.Value = True And CheckBox3.Value = True Then
        Alle
    Else
        MsgBox ("Es wurde nichts ausgewählt")
    End If

End Sub

Sub Hund()
' Hund Makro
    Worksheets("Tabelle2").Range("$A$4:$B$8").AutoFilter Field:=2, Criteria1:="Hund"
End Sub
Sub Katze()
' Katze Makro
    Worksheets("Tabelle2").Range("$A$4:$B$8").AutoFilter Field:=2, Criteria1:="Katze"
End Sub
Sub Vogel()
' Vogel Makro
    Worksheets("Tabelle2").Range("$A$4:$B$8").AutoFilter Field:=2, Criteria1:="Vogel"
End Sub
Sub Alle()
' Alle Makro
    Worksheets("Tabelle2").Range("$A$4:$B$8").AutoFilter Field:=2
End Sub
Sub HundKatze()
' HundKatze Makro
    ActiveSheet.Range("$A$6:$B$13").AutoFilter Field:=2, Criteria1:="=Hund", _
        Operator:=xlOr, Criteria2:="=Katze"
End Sub
Sub KatzeVogel()
' KatzeVogel Makro
    ActiveSheet.Range("$A$6:$B$13").AutoFilter Field:=2, Criteria1:="=Katze", _
        Operator:=xlOr, Criteria2:="=Vogel"
End Sub
Sub HundVogel()
' HundVogel Makro
    ActiveSheet.Range("$A$6:$B$13").AutoFilter Field:=2, Criteria1:="=Hund", _
        Operator:=xlOr, Criteria2:="=Vogel"
End Sub

Das funktioniert soweit ganz gut.

Allerdings benötige ich Formularsteuerelemente Kontrollkästchen. Die Ergebnisse sollen sich schon während ein Kontrollkästchen betätigt wird aktualisieren. Aktuell läuft das über ActiveX-Steuerelemente Kontrollkästchen und CommandButton.

Gegenüberstellung der Varianten:

Nachgebaute Excel:

Bis auf die G4 funktioniert alles sehr gut. Vielleicht seht ihr den Fehler. Auf eine einfache Formel wie im Funktionstest reagiert die Zelle.

Vielen Dank für eure Hilfe. Liebe Grüße

...zum Beitrag

Excel VBA Button per doppelklick?

Moinsen,

Ich würde gerne einen versteckten Button erstelln, der folgendes Kann:

Sub CommandButton1_Click()

If ActiveSheet.ProtectContents = False Then

ActiveSheet.Protect Password:="+1516", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True

Else

ActiveSheet.Unprotect

End If

Jedoch würde ich ihn gerne nur per Doppelklick aktivieren lassen, da man sonst evt ausversehen drauf kommt.

...zum Beitrag

Arbetismappe mit datum durchsuchen?

Hallo Zusammen,

ich habe eine Arbeitsmappe mit Tabellenblätter, wo sich die Namen variieren.

Da aber im jeden Tabellenblatt in Zelle A1 ein Datum Steht, will ich jedes Tabellenblatt dem Heutigen datum suchen, zellen aus dem blatt kopieren und in eine Andere arbeitsmappe einfügen, danach das gleiche noch einmal mit dem gestrigen datum.

Aktuell sieht mein Code so aus, aber der gibt mir nur die MsgBox, dass nichts gefunden worden ist.

  'Aktuelles Datum auswählen bei Start
Dim bolHabWasGefunden As Boolean
Dim wksTabelle As Worksheet
Dim rngSpalteA As Range
Dim rngZelleGefunden As Range
For Each wksTabelle In ThisWorkbook.Worksheets
 Set rngSpalteA = wksTabelle.Columns(1)
 Set rngZelleGefunden = rngSpalteA.Find(Date, LookIn:=xlValues)
 If Not rngZelleGefunden Is Nothing Then
  wksTabelle.Activate
  rngZelleGefunden.Select
  bolHabWasGefunden = True
  Exit For
 End If
Next
If bolHabWasGefunden = False Then
 MsgBox Date, , "Hab ich nicht gefunden:"
End If

Kennt da jemand einen ansatz bzw, eine lösung?

...zum Beitrag

For Steuervariabel wird bereits verwendet! was bedeutet das?

Hallo nochmals,

ich habe mit hilfe con einigen "gutefrage.net" usern einen code geschrieben und versuche jzt durch "Copy-Paste" es für jede Zelle anzuwenden.

Beim For-Befehl kommt immer folgende Meldung "For Steuervariabel wird bereits verwendet"

was bedeutet das ? heißt es, das man das "For" nur einmal in einem code gebrauchen kann ? wäre vielleicht ein "GoTo" befehl angebrachter? ( sprich: go to next cell, wenn die bedingung erfüllt ist )

hier ist der code:

sub kopieren( )

Dim Zelle As Range Dim Wert As Variant

Wert = ActiveSheet.Range("J16:j29")

With Sheets("Tabelle2") For Each Zelle In .Range("F6:G6")

If ((Range("J16").EntireRow.Hidden = True)

Or (Range("J16").EntireColumn.Hidden = True))

Or (Range("J16").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J17")

Else

Zelle.Value = ActiveSheet.Range("J16")

With Sheets("tabelle2")

For Each Zelle In .Range("H6:I6")

If ((Range("J17").EntireRow.Hidden = True)

Or (Range("J17").EntireColumn.Hidden = True))

Or (Range("J17").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J18")

Else

Zelle.Value = ActiveSheet.Range("J17")

End If End With End If Next Zelle End With End Sub

Danke schonmal für eure Tatkräftigen Hilfen :)))

Gruß Newb

...zum Beitrag

Wie kann ich bei Excel einen Button erstellen der abspeichert?

Hallo,

Ich würde gerne bei Excel einen Button erstellen, der die Excel mappe auf dem Desktop abspeichert. Der Name der Datei soll in Zeile A1 stehen.

Den Button habe ich bereits erstellt. Ich scheitere noch bei dem Makro, weil ich keine ahnung davon habe. Ich habe etwas im Internet gefunden, was meinen Vorstellungen nahe kommt. Ich habe versucht es anzupassen, aber irgendwie klappt das alles nicht.

Sub Schaltfläche1_Klicken()
Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("A1").Value
lw_pfad = InputBox("Geben Sie hier das Laufwerk und den Pfad an, wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) & "(Ihre Eingabe wird in A1 als neuer Default-Wert gespeichert.)", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("A1").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls"
MsgBox "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls gespeichert.", , "OK"
End If
End Sub

Das ist, was ich bis jetzt habe.

Vielen Dank für die Hilfe im Voraus!

...zum Beitrag

Excel VBA: Tabellenblätter bei gewissen Zellenwert ausblenden?

Hallo Zusammen,

Ich will mittels VBA ein Excel modifizieren, damit möglichst wenige Tabellenblätter angezeigt werden. In einem Tabellenblatt (z.B. "Auswahl") habe ich die Zellen C62, C88 und C114, die jeweils ein spezielles Tabellenblatt anzeigen sollen. Jedoch gibt es im Moment nur LZF-Meldungen.

Es soll jeweils bei "Yes" nichts angezeigt, bei "No" die entsprechende Tabelle eingeblendet werden.

Ansonsten sollen die "nicht betroffenen" Tabellen ausgeblendet bleiben

Hier der Code im Worksheet "DieseArbeitsmappe":

Private Sub Worksheet_Open()

'Beim Öffnen des Excels die betroffenen Blätter ausblenden
    ThisWorkbook.Worksheets("Tabelle4").Visible = False 
    ThisWorkbook.Worksheets("Tabelle5").Visible = False
    ThisWorkbook.Worksheets("Tabelle6").Visible = False
    
End Sub

In Blatt "Auswahl" (Tabelle7) habe ich folgenden Code:

Private Sub Worksheet_Change(ByVal Target As Range)

   

‘Hier sind vorher noch andere IF-Regeln hinterlegt, die nur Reihen in Tabelle7 ein/ausblenden

   

    If Range("C62").Value = "No" Then 'Tabellenblätter einblenden, sobald in der jeweiligen Zelle "No" ausgewählt wird

        ThisWorkbook.Worksheets("Tabelle6").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle6").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C88").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle5").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle5").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C114").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle4").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle4").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

End Sub

Weshalb gibt es jeweils einen Fehler und wie kann ich diesen am einfachsten beheben?

Vielen Dank, Michael

...zum Beitrag

Richtig Einfügen in Excel-VBA?

Ich bin mir auch nicht sicher ob ich Richtig in VBA einfüge, der Sub Kopieren funktioniert nicht.

Mein Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E8")) Is Nothing Then

Cells.EntireRow.Hidden = False

If Range("E8").Value = "Rogo AC" Then

Columns("U:AH").Hidden = True

Columns("U").Hidden = False

ElseIf Range("E8").Value = "Shunt 100A" Then

Columns("U:AH").Hidden = True

Columns("V").Hidden = False

End If

End Sub

-------------------------------------------------------------------------------------------------------------------------------

Sub Kopieren_speichern()

For i = 27 To 37

If Range("AK" & i).Value > 1 Then

Range("M" & i).Value = Range("AK" & i).Value

End If

Next i

End Sub

Danke im Voraus

...zum Beitrag

Bei Serienbrief Dokumente einzeln Speichern mit Makro funktioniert nicht?

Ich möchte die Dokumente im Serienbrief einzeln automatisch speichern mittels Makro und habe das unten angefügte Makro dafür auch gefunden aber es funktioniert bei mir noch nicht sondern debugt immer und zeigt Fehler in der Variable an. Ich hab auch den Pfad schon auf mein Dokument angepasst. Muss ich evtl noch den Dateinamen ändern?

Sub Test()
 '
 ' Serienbrief in einzelnen Word Dokumenten speichern
 '
 Dim Dateiname As String
 Dim LetzterRec As Long
     
 Application.ScreenUpdating = False
 Application.Visible = False

 Const path As String = "C:\Test\"          'Pfad anpassen
 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
 LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord
 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord


     With ActiveDocument.MailMerge
         .DataSource.ActiveRecord = wdFirstRecord
         Do
             If .DataSource.ActiveRecord > 0 Then
                If .DataSource.DataFields("VorNachname").Value <> "0" Then
                     .Destination = wdSendToNewDocument
                    .SuppressBlankLines = True

                     With .DataSource
                         .FirstRecord = .ActiveRecord
                         .LastRecord = .ActiveRecord
                
                         Dateiname = path & .DataFields("VorNachname").Value & ".docx"
                
                     End With
                        .Execute Pause:=False
                 
                         ActiveDocument.SaveAs FileName:=Dateiname           'Speichern unter Dateiname
                        ActiveDocument.Close False
                 End If

               End If
               
             If .DataSource.ActiveRecord < LetzterRec Then
                 .DataSource.ActiveRecord = wdNextRecord
             Else
                 Exit Do
             End If
         Loop
     End With
     
     Application.Visible = True
     Application.ScreenUpdating = True
 End Sub

...zum Beitrag

Excel VBA Selection begrenzen?

Hallo zusammen.

Ich komme leider beim meinem Problem nicht alleine weiter.

In meiner Tabelle werden in Spalte 2 und Zeile 4 Zeichen angezeigt, sobald ein Bereich selektiert wird. Die Zeichen sollen sich allerdings nur auf die Range J7:OJ57 beschränken, auch wenn die Selektion über die Range hinausgeht.

Denn jetzt, wenn ich z.B. eine Spalte markiere, schreibt der Code mir alle Zeichen in jede Zeile der Spalte, was fatal ist.

Kann ein Profi kurz helfen? :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J6:OJ57")) Is Nothing Then
Dim cell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
   Range("B6:B57").ClearContents
   Range("J4:OJ4").ClearContents
For Each cell In selection
  With cell
   Range(cell(.Row, 2), Cells(.Row, 2)) = ">>"
   Range(cell(4, .Column), Cells(4, .Column)) = "V"
  End With
Next
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End If
End Sub

...zum Beitrag

Das Tabellenblatt öffnet sich nicht?

Hallo, ich habe Button womit ich eine Datei und darin direkt eine Eingabemaske öffnen will. Mein bisheriger Code aktiviert / öffnet die Datei, was mir fehlt, ist die direkte Anzeige der Eingabemaske. Ich stelle den Code mal hier ein, um vielleicht eine Lösung zu erhalten. Ich komme einfach nicht weiter.


Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim passwort As String
    Dim pfad_zur_datei As String
    Dim wb As Workbook
    Dim bestaetigung As VbMsgBoxResult

    ' Bestätigungsnachricht anzeigen und Passwort abfragen
    bestaetigung = MsgBox("Möchten Sie fortfahren?", vbQuestion + vbYesNo, "Bestätigung")

    ' Wenn der Benutzer auf "Ja" klickt
    If bestaetigung = vbYes Then
        passwort = InputBox("Geben Sie das Passwort ein:", "Passwortabfrage")

        ' Überprüfe das eingegebene Passwort
        If passwort = "123" Then ' Ersetze "dein_passwort" durch das gewünschte Passwort
            ' Konstruiere den vollständigen Pfad zur Datei
            pfad_zur_datei = "G:\NEU Reduziert für DEMO.xlsm" ' Passe den Pfad an

            ' Überprüfe, ob das Arbeitsblatt "Auswahlklick" existiert
            On Error Resume Next
            Set ws = Workbooks.Open(pfad_zur_datei).Worksheets("Auswahlklick")
            On Error GoTo 0

            ' Wenn das Arbeitsblatt existiert, aktiviere es
            If Not ws Is Nothing Then
                ws.Activate
            Else
                MsgBox "Das Arbeitsblatt 'Auswahlklick' wurde nicht gefunden.", vbExclamation
                Exit Sub
            End If
        Else
            MsgBox "Falsches Passwort. Der Zugriff wurde verweigert.", vbExclamation
            Exit Sub
        End If
    Else
        MsgBox "Vorgang abgebrochen.", vbInformation
        Exit Sub
    End If

    ' Hier den restlichen Code ausführen, der auf dem geöffneten Arbeitsblatt "ws" basiert

End Sub

...zum Beitrag

VBA Laufzeitfehler/ Error/ Programm hängt sich auf?

Hallo zusammen,

Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.

Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.

Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "Perfektion"

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

 

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

 

Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "F.n.B."

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

Spalten löschen

Private Sub Kompetenzenentfernen_Click() 'Spalten löschen

ActiveSheet.Unprotect Password:="MNPS"

If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then

MsgBox "Spalte kann nicht gelöscht werden"

Else

Selection.EntireColumn.Delete Shift:=xlUp

End If

'ActiveSheet.Protect Password:="MNPS"

End Sub

Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.

Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?

Vielen Dank im Voraus!

...zum Beitrag

Excel VBA UserForm "Passwort ändern" funktioniert nicht?

Ich komme echt nicht weiter bei so einem einfachen Code! :(

Das Problem ist, dass die UserForm einmal funktioniert, aber beim zweiten Mal sagt er "Das Passwort ist nicht korrekt", obwohl es das eigentlich sein müsste. Per Direktbereich abgefragt ergibt sich dann immer, dass das Passwort auf "" steht. Findet jemand im Code den Fehler?

PS: "NeuesPasswort1" steht für die obere, "NeuesPasswort2" für die untere Reihe.

Option Explicit

Sub CheckBoxAltesPasswort_Click()
  If CheckBoxAltesPasswort.Value = True Then
    TextBoxAltesPasswort.PasswordChar = ""
    Else
      TextBoxAltesPasswort.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort1_Click()
  If CheckBoxNeuesPasswort1.Value = True Then
    TextBoxNeuesPasswort1.PasswordChar = ""
    Else
      TextBoxNeuesPasswort1.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort2_Click()
  If CheckBoxNeuesPasswort2.Value = True Then
    TextBoxNeuesPasswort2.PasswordChar = ""
    Else
      TextBoxNeuesPasswort2.PasswordChar = "*"
  End If
End Sub

Sub CommandButtonAbbrechen_Click()
  Me.Hide
End Sub

Sub CommandButtonSpeichern_Click()
  If TextBoxAltesPasswort.Value <> AltesPasswort Then
    MsgBox ("Das Passwort ist nicht korrekt.")
    Exit Sub
  End If
  If TextBoxNeuesPasswort1.Value <> TextBoxNeuesPasswort2.Value Then
    MsgBox ("Die Passwörter stimmen nicht überein.")
    Exit Sub
  End If
  If Len(TextBoxNeuesPasswort1.Value) < 5 Then
    MsgBox ("Bitte wählen Sie ein Passwort mit mindestens 5 Zeichen.")
    Exit Sub
  End If
  NeuesPasswort = TextBoxNeuesPasswort1.Value
  Passwort = NeuesPasswort
  Me.Hide
End Sub

Sub UserForm_Activate()
  AltesPasswort = Passwort
End Sub

...zum Beitrag

Wie kann man in Excel per VBA abhängig von einem Wert Spalten aus-/einblenden?

Hey. Ich weiß zu diesem Thema gibt es schon ein paar Einträge im Netz. jedoch habe ich es nie für mich umformuliert bekommen. Vielleicht kann mir hier jemand helfen?

In Zelle G6 steht ein Wert von 1-6. Abhängig davon sollen dann immer andere Spalten ausgeblendet werden. Mein Code zur Zeit:

Sub Ausblenden()
'
' Ausblenden Makro
'
' Tastenkombination: Strg+a
'
    If "G6" = "1" Then
                Columns("v:bn").EntireColumn.Hidden = False
                Columns("v:bn").EntireColumn.Hidden = True
            Else
                If "G6" = "2" Then
                    Columns("v:bn").EntireColumn.Hidden = False
                    Columns("ae:bn").EntireColumn.Hidden = True
                Else
                    If "G6" = "3" Then
                        Columns("v:bn").EntireColumn.Hidden = False
                        Columns("an:bn").EntireColumn.Hidden = True
                    Else
                        If "G6" = "4" Then
                            Columns("v:bn").EntireColumn.Hidden = False
                            Columns("aw:bn").EntireColumn.Hidden = True
                        Else
                            If "G6" = "5" Then
                                Columns("v:bn").EntireColumn.Hidden = False
                                Columns("bf:bn").EntireColumn.Hidden = True
                            Else
                                If "G6" = "6" Then
                                    Columns("v:bn").EntireColumn.Hidden = False
                                End If
                            End If
                        End If
                    End If
                End If
    End If
End Sub

Ich bin ein VBA anfänger, also bitte seit nachsichtig x). Danke schon einmal im voraus!

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen