Sub für CommandButton ändern

[heli]

Hallo liebes Forum !

Gibt es eine Möglichkeit per VBA eine bestehende Sub z.B. Private Sub CommandButton10_Click()
zu ändern?

Ich habe etwa 100 Dateien mit je 12 Tabellenblätter und die genannte Sub sollte in allen 1200 Tabellen geändert werden, was manuell eine Weile dauern würde.

Außerdem sollten einige neue Module eingefügt werden und andere dafür gelöscht werden.
Hier habe ich schon Versuche gestartet, aber alle ohne Erfolg.

Könnte mir bitte vielleicht jemand helfen?
Vielen Dank,

Liebe Grüße aus Innsbruck
Helmut

[Steffl]

Hallo Helmut,

was willst Du in der Sub ändern?

Schaue mal hier vorbei. Oder schau bei der Homepage von Monika Can auf die Leiste. Das findest Du unter dem Punkt "Lesenwertes für Fortgeschrittene" das was Du suchst.

[heli]

Hallo Helmut,

was willst Du in der Sub ändern?

Schaue mal hier vorbei. Oder schau bei der Homepage von Monika Can auf die Leiste. Das findest Du unter dem Punkt "Lesenwertes für Fortgeschrittene" das was Du suchst.

Hallo Stefan !

Vielen Dank für Deine Hilfe.
Ich möchte diesen Code, oder zumindest den Teil zwischen Sub CommandButton10  und End Sub  durch den anderen ersetzen.

Code:

Private Sub CommandButton10_Click()
druck = True
Änderung_Speich_1TB
ActiveSheet.PrintOut
druck = False
End Sub

zu ersetzen durch:

Private Sub CommandButton10_Click()           

    Dim tb
    tb = ActiveSheet.Name
Änderung_Speich_1TB         'Modul
    Sheets(tb).Select
    ActiveSheet.PrintOut
End Sub

Ich habe einen Versuch mit dem Code per Code manipulieren Teil 12  gemacht, aber ohne Erfolg.
Irgendetwas habe ich falsch gemacht.

Liebe Grüße
Helmut

[Winny]

Hi

das hier ändert eine Mappe, noch eine Schleife drumherum und deine Arbeitsblätter sind geändert

Code:

Option Explicit

Sub tst()
  Dim wb As Workbook

  Set wb = Workbooks("Testmappe.xlsm")
  prcStart wb
End Sub

'Nach http://www.office-loesung.de/ftopic192212_15_0_asc.php von Lukas Mosimann

Public Sub prcStart(wb As Workbook)
  Dim objVBComponents As Object, i As Integer, j As Integer
  With wb.VBProject
     For Each objVBComponents In .VBComponents
        Select Case objVBComponents.Type
        Case 1, 2, 3 'Module, Klasssenmodule, Userforms
           '.VBComponents.Remove .VBComponents(objVBComponents.Name)
        Case 100 'Workbook, Sheets, Carts
           Call prcFindProc("CommandButton10_Click", objVBComponents.CodeModule, i, j)
           If i > 0 And j > 0 Then
              Call prcDelete(objVBComponents.CodeModule, i, j)
              Call InsertProc(objVBComponents.CodeModule, i)
           End If
        End Select
     Next
  End With
End Sub

Public Sub prcFindProc(strProc As String, objCodeModule As Object, intStartLine As Integer, intEndLine As Integer)
  Dim intLine As Integer
  With objCodeModule
     For intLine = 1 To .CountOfLines
        If .ProcOfLine(intLine, 0) = strProc Then
           If intStartLine = 0 And InStr(1, .Lines(intLine, 1), strProc) > 0 Then
              intStartLine = intLine + 1
           Else
              intEndLine = intLine
           End If
        End If
     Next
     intEndLine = intEndLine - intStartLine
     'If intStartLine <> 0 Then _
         .DeleteLines intStartLine, intEndLine - intStartLine + 1
  End With
End Sub

Public Sub prcDelete(objCodeModule As Object, intStartLine As Integer, intEndLine As Integer)
  objCodeModule.DeleteLines intStartLine, intEndLine
End Sub

Sub InsertProc(objCodeModule As Object, i As Integer)
  With objCodeModule
     .InsertLines i + 0, "   Dim tb"
     .InsertLines i + 1, "   tb = ActiveSheet.Name"
     .InsertLines i + 2, "   Änderung_Speich_1TB         'Modul"
     .InsertLines i + 3, "   Sheets(tb).Select"
     .InsertLines i + 4, "   ActiveSheet.PrintOut"
  End With
End Sub

[Steffl]

Hallo Helmut,

den Hinweis, dass Du den Haken bei VB-Projekt vertrauen setzen musst, hast Du schon beachtet?

Wenn ich aber betrachte was für eine Codeänderung Du vor hast, dann wundere ich mich schon ein wenig. Einerseits willst Du Code per Code ändern, was vom Verständnis her gesehen nicht so einfach ist, andererseits willst Du hier eine Zeile einfügen, wo ein Sheet selektiert wird. Dazu einen Satz: Das Selektieren und Aktivieren von Arbeitsblättern bzw. Zellen ist in den allermeisten Fällen unnötig! Mit

Code:

Sheets(tb).PrintOut

geht es auch ohne Select.

[schauan]

Hallo Helmut,

Ich habe einen Versuch mit dem Code per Code manipulieren Teil 12 gemacht, aber ohne Erfolg.
Irgendetwas habe ich falsch gemacht.

Wie Du gesehen hast, kommen nach Deiner Aussage Lösungsvorschläge, die zu unterschiedlichen Fehlerursachen passen. Eventuell kannst Du näher beschreiben, was bei Deinem Versuch passiert oder auch nicht.

[Winny]

Hi

wenn man sich den Teil12 anschaut erkennt man nach dass er ziemlich ungeeignet für das Vorhaben ist. Da der TE das nicht erkannt hat ging ich davon aus dass er auch mit den anderen Teilen so seine Schwierigkeiten haben würde und habe ihm deshalb eine fertige Lösung zur Verfügung gestellt. Trotz toller Aufbereitung durch Lukas ist das Thema halt nicht trivial. Evtl. hat ja jemand Lust ihm noch das Einlesen der 100 Arbeitsblätter zu programmieren...

[Steffl]

Hallo Winny,

die Erklärungen in den Teilen hat aber meistens Nepumuk geschrieben. Und Du hast Recht, das ist nicht trivial.

[heli]

Hi

das hier ändert eine Mappe, noch eine Schleife drumherum und deine Arbeitsblätter sind geändert

Code:

Option Explicit

Sub tst()
  Dim wb As Workbook

  Set wb = Workbooks("Testmappe.xlsm")
  prcStart wb
End Sub

'Nach http://www.office-loesung.de/ftopic192212_15_0_asc.php von Lukas Mosimann

Public Sub prcStart(wb As Workbook)
  Dim objVBComponents As Object, i As Integer, j As Integer
  With wb.VBProject
     For Each objVBComponents In .VBComponents
        Select Case objVBComponents.Type
        Case 1, 2, 3 'Module, Klasssenmodule, Userforms
           '.VBComponents.Remove .VBComponents(objVBComponents.Name)
        Case 100 'Workbook, Sheets, Carts
           Call prcFindProc("CommandButton10_Click", objVBComponents.CodeModule, i, j)
           If i > 0 And j > 0 Then
              Call prcDelete(objVBComponents.CodeModule, i, j)
              Call InsertProc(objVBComponents.CodeModule, i)
           End If
        End Select
     Next
  End With
End Sub

Public Sub prcFindProc(strProc As String, objCodeModule As Object, intStartLine As Integer, intEndLine As Integer)
  Dim intLine As Integer
  With objCodeModule
     For intLine = 1 To .CountOfLines
        If .ProcOfLine(intLine, 0) = strProc Then
           If intStartLine = 0 And InStr(1, .Lines(intLine, 1), strProc) > 0 Then
              intStartLine = intLine + 1
           Else
              intEndLine = intLine
           End If
        End If
     Next
     intEndLine = intEndLine - intStartLine
     'If intStartLine <> 0 Then _
         .DeleteLines intStartLine, intEndLine - intStartLine + 1
  End With
End Sub

Public Sub prcDelete(objCodeModule As Object, intStartLine As Integer, intEndLine As Integer)
  objCodeModule.DeleteLines intStartLine, intEndLine
End Sub

Sub InsertProc(objCodeModule As Object, i As Integer)
  With objCodeModule
     .InsertLines i + 0, "   Dim tb"
     .InsertLines i + 1, "   tb = ActiveSheet.Name"
     .InsertLines i + 2, "   Änderung_Speich_1TB         'Modul"
     .InsertLines i + 3, "   Sheets(tb).Select"
     .InsertLines i + 4, "   ActiveSheet.PrintOut"
  End With
End Sub

Hallo Winny,

Vielen Dank für Deine Hilfe. Ich bin noch am Testen, habe aber noch das Problem, dass wohl die angeführten Zeilen eingefügt werden, aber zusätzlich 2 alte verbleiben. Ich hoffe, ich komme noch dahinter, wo ich ansetzen muss. Kann es sein, dass die Zeilennummer eine Rolle spielt und wenn diese in den einzelnen CommandButtons nicht gleich sind der Fehler entsteht ? Wo ich auch noch ein Problem habe ist, dass ich die VBA-Sperre mittels Passwort vorübergehend aufheben müsste. Ich habe einiges versucht, aber nichts hat geklappt.
Ich melde mich wieder.
Liebe Grüße
Helmut

[Winny]

Hallo Helmut

das mit den verbleibenden Zeilen kann ich nicht nachvollziehen da das Makro alles zwischen Sub Commandxxxxxxx und End Sub löscht, zumindest hier.Poste doch mal solch eine Sub im Original wo nach dem Einfügen noch zwei alte Zeilen verbleiben

Die Passwortsperre im VBA Projekt kann man zumindest nicht zuverlässig per VBA aufheben, es gibt wohl Versuche mit Sendkeys aber damit kenne ich mich nicht aus