Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Sub für CommandButton ändern
#11
Hi

es gab doch noch Fehler die mir bei meinen Tests nicht aufgefallen sind, hier eine korrigierte und auch verbesserte Version
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
           i = 0: j = 0
           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, sLine As String
  With objCodeModule
     For intLine = 1 To .CountOfLines
        If .ProcOfLine(intLine, 0) = strProc Then
           sLine = Trim(.Lines(intLine, 1))
           If intStartLine = 0 And InStr(1, sLine, strProc) > 0 And Left(sLine, 1) <> "'" Then
              intStartLine = intLine + 1
           ElseIf intStartLine > 0 And InStr(1, sLine, "End Sub") = 0 Then
              intEndLine = intLine
           ElseIf intStartLine > 0 And InStr(1, sLine, "End Sub") > 0 Then
              Exit For
           End If
        End If
     Next
     intEndLine = 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
Antworten Top
#12
Hallo Winny,

vielen Dank für Deine Antwort.
Ich habe 12 Monatsblätter pro Datei zur Änderung und im ersten Blatt (Jänner) passt die Zeilenanzahl, aber die anderen haben die beiden ersten Zeilen zu viel.
Hier der geänderte Code ab dem zweiten Tabellenblatt:

Code:
Private Sub CommandButton10_Click()

Application.ScreenUpdating = False

Änderung_Speich_1TB         'Modul
  Application.ScreenUpdating = False
  Dim tb
  tb = ActiveSheet.Name
  Änderung_Speich_1TB         'Modul
  Sheets(tb).Select
  ActiveSheet.PrintOut
  Application.ScreenUpdating = True
End Sub
 Vielen Dank für Deine Hilfr.
Liebe Grüße
Helmut
Antworten Top
#13
Hallo Helmut

wenn das die geänderte Prozedur ist dann fällt auf dass das Application.ScreenUpdating = True am Ende nicht in meinem Code mit drin ist. Hast Du denn evtl. daran geändert? Eine Möglichkeit wäre dein Blatt zur Verfügung zu stellen, die Blätter sollten erhalten bleiben allerdings könntest Du die Daten komplett entfernen, es geht ja nur um die Makros
Grüße,
Winny
Antworten Top
#14
Hallo Winny,

vielen herzlichen Dank, jetzt hat es funktioniert, super.
Die erste und letzte Zeile habe ich hinzugefügt, passt aber alles.

Liebe Grüße
Helmut
Antworten Top


Gehe zu:


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