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.
Clever-Excel-Forum › Office-Anwendungen › Excel v
VBA-Code ändern

Thema geschlossen 
Baumstrukturmodus
VBA-Code ändern
heli Offline
Benutzer
Registriert seit: 20.06.2014
Version(en): 2013
#1
10.01.2016, 00:04
Liebes Forum !

Ich möchte Euch gerne wieder einmal um Eure geschätzte Hilfe bitten, zumal ich mit meinem geringen Latein am Ende bin.
Ich habe einen Code zum Ändern eines Codes gefunden, der auch wie gewünscht alle Tabellenblätter durchläuft und die Änderung vornimmt, bis dann plötzlich als "objCodeModule"   "DieseArbeitsmappe"  erscheint und dann führt es zu einem gravierenden Excel-Fehler und Excel wird neu gestartet.
Ich dachte ich könnte mit einer Abfrage und überspringen zum Ende eine Lösung finden, aber leider nicht.
Ich vermute es hat was mit Select Case zu tun, aber ich kann auch mit Case=100 auch nichts anfangen.
Kann mir bitte jemand sagen, woran es liegt.
Vielen Dank.
Liebe Grüße aus Innsbruck
Helmut
Code:
Sub Ändern_CB10_Code()         ' Die Sub des CB10 in allen TBs ändern
   
   Dim wb As Workbook
   Set wb = ActiveWorkbook
 
  prcStart wb
End Sub

Public Sub prcStart(wb As Workbook)
  Dim objVBComponents As Object, i As Integer, j As Integer
  With wb.VBProject    'alle Tabellen werden aufgerufen
     For Each objVBComponents In .VBComponents
        Select Case objVBComponents.Type
        Case 1   '2, 3        'Module, Klasssenmodule, Userforms
           '.VBComponents.Remove .VBComponents(objVBComponents.Name)  'wird für Module etc. verwendet
        Case 100       'Workbook, Sheets, Carts
           i = 0: j = 0
           Call prcFindProc("CommandButton10_Click", objVBComponents.CodeModule, i, j)  'Zu änderndes Modul
           'i = ab CommandButton10_Click
                                                               
           If i > 0 And j > 0 Then
              Call prcDelete(objVBComponents.CodeModule, i, j) 'Löschen aller Zeilen des Moduls
              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   'alle Tabellen werden aufgerufen
     
     'If objCodeModule = "DieseArbeitsmappe" Then
'GoTo Ende
     'End If
     
     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
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#2
10.01.2016, 09:41
Hallo Helmut,

was welche Änderungen und wo willst Du vornehmen? Doch sicherlich nicht in allen (Klassen-)Modulen und in allen Prozeduren. Dein Codebeispiel ist übrigens unvollständig.
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#3
10.01.2016, 11:07
Hallöchen,

hier mal eine Nummernübersicht:
' Modul: Typ 1
' Klasse: Typ 2
' Userform: Typ 3
' Tabelle: Typ 100
' DieseArbeitsmappe: Typ 100

Das hier
If objCodeModule = "DieseArbeitsmappe" Then
ging wohl nicht, weil "DieseArbeitsmappe" der Name ist, also besser
If objCodeModule.name = "DieseArbeitsmappe" Then

Bei Änderungen in DieseArbeitsmappe habe ich auch die Erfahrung gemacht, dass dadurch zuweilen Excel abstürzt. Eventuell hilft, die Datei mit deaktivierten Makros zu öffnen und dann zu ändern.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • heli
Homepage Suchen
Antworten Top
heli Offline
Benutzer
ThreadStarter

Registriert seit: 20.06.2014
Version(en): 2013
#4
10.01.2016, 11:27
Hallo liebe Helfer !

Vielen Dank für Eure Antwort.
Ich habe offensichtlich unbeabsichtigt nicht den ganzen Code kopiert, wofür ich mich entschuldige und darf das nun nachholen.

Es soll der Code nur für "CommandButton10"  in allen 12 Tabellenblätter (Jänner bis Dezember) geändert werden, was ja auch funktioniert, aber nach TB 12 wird "DieseArbeitsmappe" aufgerufen, was in der Folge zu einem Fehler führt und ich muss dann manuell eingreifen, d.h. speichern, das aber für eine Reihe von Dateien, die alle geändert werden müssen.

Den Hinweis "If objCodeModule.name = "DieseArbeitsmappe" Then" zu ändern, werde ich gleich testen. Vielen Dank auch für die Zahlenwerte, wo kann man diese nachlesen ?


Vielen Dank für Eure Hilfe.
Liebe Grüße
Helmut

 
Code:
Sub Ändern_CB10_Code()         ' Die Sub des CB10 in allen TBs ändern
   
   Dim wb As Workbook
   Set wb = ActiveWorkbook
 
  prcStart wb
End Sub

Public Sub prcStart(wb As Workbook)
  Dim objVBComponents As Object, i As Integer, j As Integer
  With wb.VBProject    'alle Tabellen werden aufgerufen
     For Each objVBComponents In .VBComponents
        Select Case objVBComponents.Type
        Case 1   '2, 3        'Module, Klasssenmodule, Userforms
           '.VBComponents.Remove .VBComponents(objVBComponents.Name)  'wird für Module etc. verwendet
        Case 100       'Workbook, Sheets, Carts
           i = 0: j = 0
           Call prcFindProc("CommandButton10_Click", objVBComponents.CodeModule, i, j)  'Zu änderndes Modul
           'i = ab CommandButton10_Click
                                                               
           If i > 0 And j > 0 Then
              Call prcDelete(objVBComponents.CodeModule, i, j) 'Löschen aller Zeilen des Moduls
              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   'alle Tabellen werden aufgerufen
     
     'If objCodeModule = "DieseArbeitsmappe" Then
'GoTo Ende
     'End If
     
     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


Ende:
End Sub

Public Sub prcDelete(objCodeModule As Object, intStartLine As Integer, intEndLine As Integer)
  objCodeModule.DeleteLines intStartLine, intEndLine       'Löschen des Inhaltes bis End Sub
End Sub
Sub InsertProc(objCodeModule As Object, i As Integer)       'Einfügen des neuen Codes
  With objCodeModule
    .InsertLines i + 0, "   Application.ScreenUpdating = False"
    .InsertLines i + 1, "   Dim tb"
    .InsertLines i + 2, "   tb = ActiveSheet.Name"
    .InsertLines i + 3, "   Änderung_Speich_1TB         'Modul"
    .InsertLines i + 4, "   Sheets(tb).Select"
    .InsertLines i + 5, "   druck=True"
    .InsertLines i + 6, "   ActiveSheet.PrintOut"
    .InsertLines i + 7, "   Application.ScreenUpdating = True"
  End With
End Sub
Suchen
Antworten Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#5
10.01.2016, 11:33
Hallo Helmut,

die Nummern stehen bestimmt irgendwo bei Microsoft. Über einen Umweg bekommt man aber auch selber was raus. Füge ein Modul, ein Klassenmodul und ein Userform ein, lasse diesen code laufen und schaue ins Direktfenster Wink

Code:
Sub test()
With ThisWorkbook.VBProject
    For Each vbc In .VBComponents
    Debug.Print vbc.Name & vbTab & vbc.Type
    Next
End With
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • heli
Homepage Suchen
Antworten Top
heli Offline
Benutzer
ThreadStarter

Registriert seit: 20.06.2014
Version(en): 2013
#6
10.01.2016, 22:22
Hallo Andrè !

Ich habe die Abfrage "If objVBComponents.CodeModule.Name = "DieseArbeitsmappe" Then" nun unter "Sub prcStart(wb As Workbook)" gestellt und dann ging es.
Ich wollte die Anzahl Dateien mittels "Do While / Loop"  nacheinander abarbeiten lassen, das ging aber erst, als ich am Ende anstatt "Workbooks(strFileName).Close SaveChanges:=True"  durch

"Workbooks(strFileName).Save"   und
"Workbooks(strFileName).Close"  ersetzt habe, keine Ahnung warum !

Hier noch einmal der Code.

Ich musste allerdings alle Dateien zuerst mit meinem VBA-Kennwort die Sperre öffnen, da ich keine Möglichkeit fand dies mittels eines Codes zu öffnen, und die Key-Funktionen gehen jedenfalls mit Excel 2013 nicht mehr.
Vielen Dank nochmals.
Liebe Grüße aus Innsbruck
Helmut
Code:
Sub Ändern_CB10_Code()         ' Die Sub des CB10 in allen TBs ändern
   
   Dim wb As Workbook
   Set wb = ActiveWorkbook
 
  prcStart wb
End Sub

Public Sub prcStart(wb As Workbook)
  Dim objVBComponents As Object, i As Integer, j As Integer
  With wb.VBProject    'alle Tabellen werden aufgerufen
     For Each objVBComponents In .VBComponents
        Select Case objVBComponents.Type
        Case 1   '2, 3        'Module, Klasssenmodule, Userforms
           '.VBComponents.Remove .VBComponents(objVBComponents.Name)  'wird für Module etc. verwendet
        Case 100       'Workbook, Sheets, Carts
           i = 0: j = 0
           Call prcFindProc("CommandButton10_Click", objVBComponents.CodeModule, i, j)  'Zu änderndes Modul
           'i = ab CommandButton10_Click
  If objVBComponents.CodeModule.Name = "DieseArbeitsmappe" Then
GoTo Ende
     End If
           If i > 0 And j > 0 Then
              Call prcDelete(objVBComponents.CodeModule, i, j) 'Löschen aller Zeilen des Moduls
              Call InsertProc(objVBComponents.CodeModule, i)
           End If
        End Select
     Next
Ende:
  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   'alle Tabellen werden aufgerufen
           
     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       'Löschen des Inhaltes bis End Sub
End Sub
Sub InsertProc(objCodeModule As Object, i As Integer)       'Einfügen des neuen Codes
 
  With objCodeModule
    .InsertLines i + 0, "   Application.ScreenUpdating = False"
    .InsertLines i + 1, "   Dim tb"
    .InsertLines i + 2, "   tb = ActiveSheet.Name"
    .InsertLines i + 3, "   Änderung_Speich_1TB         'Modul"
    .InsertLines i + 4, "   Sheets(tb).Select"
    .InsertLines i + 5, "   druck=True"
    .InsertLines i + 6, "   ActiveSheet.PrintOut"
    .InsertLines i + 7, "   Application.ScreenUpdating = True"
  End With

End Sub
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


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