Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Sub für CommandButton ändern
#1
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
to top
#2
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.
Gruß Stefan
Win 7 / Office 2007
to top
#3
(06.05.2015, 18:54)Steffl schrieb: 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
to top
#4
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
Grüße,
Winny
[-] Folgende(r) 1 Benutzer sagt Danke an Winny für diesen Beitrag:
heli
to top
#5
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.
Gruß Stefan
Win 7 / Office 2007
[-] Folgende(r) 1 Benutzer sagt Danke an Steffl für diesen Beitrag:
heli
to top
#6
Hallo Helmut,

Zitat: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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#7
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...
Grüße,
Winny
to top
#8
Hallo Winny,

die Erklärungen in den Teilen hat aber meistens Nepumuk geschrieben. Und Du hast Recht, das ist nicht trivial.
Gruß Stefan
Win 7 / Office 2007
to top
#9
(06.05.2015, 23:59)Winny schrieb: 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
to top
#10
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
Grüße,
Winny
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  UserForm CommandButton Text ändern michi89287 2 110 19.10.2016, 10:05
Letzter Beitrag: michi89287
  Markierung von CommandButton nach Klick wieder entfernen Luffffy 3 203 20.09.2016, 12:12
Letzter Beitrag: Luffffy
  CommandButton Farbe und Inhalt ändern michel34497 8 604 06.08.2016, 15:01
Letzter Beitrag: michel34497
  ActiveCell.Row Werte nach und nach per CommandButton in ein Feld eintragen Nora Fernandez 6 1.010 15.01.2016, 20:37
Letzter Beitrag: schauan
  Wenn dann Abfrage per VBA mit CommandButton Peggymaus 1 1.129 12.03.2015, 19:21
Letzter Beitrag: cysu11
  VBA CommandButton verknüpfen mit Zelle Travis5002 8 2.838 09.01.2015, 13:27
Letzter Beitrag: Rabe
  CommandButton mit Variablen erzeugen hziemer 2 1.062 12.10.2014, 08:33
Letzter Beitrag: hziemer
  CommandButton Farbe ändern michel34497 21 14.885 24.04.2014, 18:11
Letzter Beitrag: Zwergel

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste