HEUR/Macro.Excel2000
P.Ockert
ich wende mich an euch da ich einfach nicht weiter weiß. Ich habe ein großes Programm geschrieben mit einigen Funktionen. Hab das Programm versioniert aufgebaut. Als ich dann von der Version 11 auf Version 12 kleine Änderungen gemacht habe, kam bei der Version 12 auf einmal bei Antivir immer HEUR/Macro.Excel2000 und im Geschäft kann ich dann mit der Datei nichts mehr anfangen. Hab durch ausgrenzen einzelner Funktionen den "Fehler" auf eine Funktion eingrenzen können. Nun komm ich aber nicht weiter weil ich irgendwie selbst bei FAST identischem Quellcode immer noch diese Warnung bekommen.
Zur Funktion:
Die Funktion ist dafür da wenn ich auf den Button Add_CLX klicke, dass er mit zusätzliche Buttons für einen 2. oder 3. Import generiert zusätzlich auch mehrere Tabs für den Import und den Export.
Hier die Funktion der Version 12:
Private Sub Add_CLX_Click()
Dim Object_IN As OLEObject
Dim Object_OUT As OLEObject
Dim Object_Clear As OLEObject
Dim Tabsheet_IN As Worksheet
Dim Tabsheet_OUT As Worksheet
Dim Eingabeaufforderung
Anzahl = 1
Vorhanden = 0
'****For the buttons in Main:******
For i = 1 To Worksheets("Main").OLEObjects.Count
If Mid(Worksheets("Main").OLEObjects(i).Name, 1, 3) = "CLX" And InStrRev(Worksheets(" _
Main").OLEObjects(i).Name, "IN") > 0 Then
Button_Last_ID = i
Vorhanden = Vorhanden + 1
End If
If Worksheets("Main").OLEObjects(i).Name = "CLX0_IN" Then
Set Object_IN = Worksheets("Main").OLEObjects(i)
ElseIf Worksheets("Main").OLEObjects(i).Name = "CLX0_OUT" Then
Set Object_OUT = Worksheets("Main").OLEObjects(i)
ElseIf Worksheets("Main").OLEObjects(i).Name = "Clear_CLX0_IN" Then
Set Object_Clear = Worksheets("Main").OLEObjects(i)
End If
Next i
Application.ScreenUpdating = False
'Data of the last button:
Button_Last_Top = Worksheets("Main").OLEObjects(Button_Last_ID).Top
Button_Last_Caption = Worksheets("Main").OLEObjects(Button_Last_ID).Object.Caption
Anfang = 4
Laenge = InStr(Button_Last_Caption, "_") - Anfang
Button_Last_CLX = Mid(Button_Last_Caption, Anfang, Laenge)
'****For the buttons in CFG_CHASSIe:******
vorhanden_CFG = 0
For i = 1 To Worksheets("CFG_CHASSI").OLEObjects.Count
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Name, 1, 12) = "SYM_from_CLX" Then
Button_CFG_Last_ID = i
vorhanden_CFG = vorhanden_CFG + 1
ElseIf Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Object.Caption, 1, 10) = "SYM_to_CLX" _
_
Then
'Needed for SYM_TO_CLX*, difference between SYM_TO_CLX* and SYM_from_CLX* is .Left
Button_CFG_Last_Right = Worksheets("CFG_CHASSI").OLEObjects(i).Left
End If
Next i
Application.ScreenUpdating = False
For i = 1 To Anzahl
'*******Creating CLX*_IN-Button and Tab***********
Worksheets("Main").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=Object_IN.Left, Top:=Button_Last_Top + Object_IN.Height * i, Width:= _
Object_IN.Width, Height:=Object_IN.Height
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Object.Caption = " _
CLX" & Button_Last_CLX + i & "_IN"
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Name = "CLX" & _
Button_Last_CLX + i & "_IN"
Set Tabsheet_IN = Worksheets("IN_CLX0")
Tabsheet_IN.Copy before:=Worksheets("OUT_E3")
Worksheets("IN_CLX0 (2)").Name = "IN_CLX" & Button_Last_CLX + i
A = 11
While Worksheets("IN_CLX" & Button_Last_CLX + i).Cells(A, 1) "" Or Worksheets(" _
IN_CLX" & Button_Last_CLX + i).Cells(A, 6) "" Or Worksheets("IN_CLX" & Button_Last_CLX + i). _
Cells(A, 12) ""
Worksheets("IN_CLX" & Button_Last_CLX + i).Rows(A).Clear
A = A + 1
Wend
'********Copy VBA Code of CLX0_IN to CLXi_IN***********
With ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("CLX0_IN_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("CLX0_IN_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines - 2 >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub CLX0_IN_Click()" Then
Sub_Code_line_Content = "Private Sub CLX" & Button_Last_CLX + i & " _
_IN_Click()"
ElseIf Trim(Sub_Code_line_Content) = "Tabelle_in = ""IN_CLX0""" Then
Sub_Code_line_Content = " Tabelle_in = ""IN_CLX" & Button_Last_CLX + i & _
_
ElseIf Trim(Sub_Code_line_Content) = "Zeile_Main = 14" Then
Sub_Code_line_Content = " Zeile_Main = " & 14 + (Button_Last_CLX + i) * _
_
2
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating Clear_IN_CLX*-Button and Tab***********
Worksheets("Main").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=Object_Clear.Left, Top:=Button_Last_Top + Object_Clear.Height * i, _
Width:=Object_Clear.Width, Height:=Object_Clear.Height
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Object.Caption = " _
Clear_CLX" & Button_Last_CLX + i & "_IN"
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Name = "Clear_CLX" & _
_
Button_Last_CLX + i & "_IN"
'********Copy VBA Code of Clear_CLX0 to Clear_CLXi***********
With ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("Clear_CLX0_IN_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("Clear_CLX0_IN_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub Clear_CLX0_IN_Click()" Then
Sub_Code_line_Content = "Private Sub Clear_CLX" & Button_Last_CLX + i & " _
_IN_Click()"
ElseIf Trim(Sub_Code_line_Content) = "i = 14" Then
Sub_Code_line_Content = " i = " & 14 + (Button_Last_CLX + i) * 2
ElseIf Trim(Sub_Code_line_Content) = "tab_name = ""IN_CLX0""" Then
Sub_Code_line_Content = " tab_name = ""IN_CLX" & Button_Last_CLX + i & "" _
_
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
'*******Copy VBA Sub() of SYM_from_CLX0_to_E3 to All_to_E3***********
Sub_Code_lines = .ProcCountLines("Clear_INs_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("Clear_INs_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Ende_der_Sub = False
While Ende_der_Sub = False
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "End Sub" Then
.InsertLines Sub_Code_line, " Call Clear_CLX" & Button_Last_CLX + i & " _
_
_IN_Click"
Ende_der_Sub = True
End If
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of CLX* column in CFG_CHASSI***********
A = 4
While Worksheets("CFG_CHASSI").Cells(9, A) ""
A = A + 1
Wend
Worksheets("CFG_CHASSI").Columns(A).EntireColumn.Insert
Worksheets("CFG_CHASSI").Columns(A - 1).Copy Destination:=Worksheets("CFG_CHASSI"). _
Columns(A)
Worksheets("CFG_CHASSI").Cells(9, A) = "CLX" & Button_Last_CLX + i
'Data of last Button in CFG:
Button_CFG_Last_Top = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Top
Button_CFG_Last_Height = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Height
Button_CFG_Last_Left = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Left
Button_CFG_Last_Width = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Width
'*******Create SYM_from_CLX*-Button***********
Worksheets("CFG_CHASSI").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
_
DisplayAsIcon:=False, Left:=Button_CFG_Last_Left, Top:=Button_CFG_Last_Top + _
Button_CFG_Last_Height * i, Width:=Button_CFG_Last_Width, Height:=Button_CFG_Last_Height
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Object. _
_
Caption = "SYM_from_CLX" & Button_Last_CLX + i & "_to_E3"
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Name = " _
_
SYM_from_CLX" & Button_Last_CLX + i & "_to_E3"
'*******Copy VBA Code of SYM_from_CLX0_to_E3 to SYM_from_CLX*_to_E3***********
With ThisWorkbook.VBProject.VBComponents("Tabelle2").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("SYM_from_CLX0_to_E3_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("SYM_from_CLX0_to_E3_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub SYM_from_CLX0_to_E3_Click()" Then
Sub_Code_line_Content = "Private Sub SYM_from_CLX" & Button_Last_CLX + i & " _
_
_to_E3_Click()"
ElseIf Trim(Sub_Code_line_Content) = "CLX_Name = ""IN_CLX0""" Then
Sub_Code_line_Content = " CLX_Name = ""IN_CLX" & Button_Last_CLX + i & "" _
_
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of SYM_to_CLX*-Button and Tab***********
Worksheets("CFG_CHASSI").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
_
DisplayAsIcon:=False, Left:=Button_CFG_Last_Left + Button_CFG_Last_Width, Top:= _
Button_CFG_Last_Top + Button_CFG_Last_Height * i, Width:=Button_CFG_Last_Width, Height:=Button_CFG_Last_Height
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Object. _
_
Caption = "SYM_to_CLX" & Button_Last_CLX + i
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Name = " _
_
SYM_to_CLX" & Button_Last_CLX + i
'*******Copy VBA Code of SYM_to_CLX0 in SYM_to_CLX************
With ThisWorkbook.VBProject.VBComponents("Tabelle2").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("SYM_to_CLX0_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("SYM_to_CLX0_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub SYM_to_CLX0_Click()" Then
Sub_Code_line_Content = "Private Sub SYM_to_CLX" & Button_Last_CLX + i & " _
_
_Click()"
ElseIf Trim(Sub_Code_line_Content) = "CFG_Cell = 4" Then
Sub_Code_line_Content = " CFG_Cell = " & 4 + i
ElseIf Trim(Sub_Code_line_Content) = "CLX_OUT = ""OUT_CLX0""" Then
Sub_Code_line_Content = " CLX_OUT = ""OUT_CLX" & i & """"
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
'*******Copy VBA Sub() of SYM_from_CLX0_to_E3 to All_to_E3***********
Sub_Code_lines = .ProcCountLines("All_to_E3_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("All_to_E3_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Ende_der_Sub = False
While Ende_der_Sub = False
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "End Sub" Then
.InsertLines Sub_Code_line, " Call SYM_from_CLX" & Button_Last_CLX + i & _
_
"_to_E3_Click"
Ende_der_Sub = True
End If
Sub_Code_line = Sub_Code_line + 1
Wend
'*******Copy VBA Sub() of SYM_to_CLX* to All_to_CLX***********
Sub_Code_lines = .ProcCountLines("All_to_CLX_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("All_to_CLX_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Ende_der_Sub = False
While Ende_der_Sub = False
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "End Sub" Then
.InsertLines Sub_Code_line, " Call SYM_to_CLX" & Button_Last_CLX + i & " _
_
_Click"
Ende_der_Sub = True
End If
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of CLX* column in CFG_CHASSI***********
A = 2
While Worksheets("CFG_NET_IO").Cells(9, A) ""
A = A + 1
Wend
Worksheets("CFG_NET_IO").Columns(A).EntireColumn.Insert
Worksheets("CFG_NET_IO").Cells(9, A - 1).Copy Destination:=Worksheets("CFG_NET_IO"). _
Cells(9, A)
Worksheets("CFG_NET_IO").Cells(10, A - 1).Copy Destination:=Worksheets("CFG_NET_IO"). _
Cells(10, A)
Worksheets("CFG_NET_IO").Cells(9, A) = "CLX" & Button_Last_CLX + i
'*******Creating CLX*_OUT-Button and Tab***********
Worksheets("Main").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=Object_OUT.Left, Top:=Button_Last_Top + Object_OUT.Height * i, _
Width:=Object_OUT.Width, Height:=Object_OUT.Height
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Object.Caption = " _
CLX" & Button_Last_CLX + i & "_OUT"
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Name = "CLX" & _
Button_Last_CLX + i & "_OUT"
Set Tabsheet_OUT = Worksheets("OUT_CLX0")
Tabsheet_OUT.Copy before:=Worksheets("Rev.Info")
Worksheets("OUT_CLX0 (2)").Name = "OUT_CLX" & Button_Last_CLX + i
A = 11
While Worksheets("OUT_CLX" & Button_Last_CLX + i).Cells(A, 1) "" Or Worksheets(" _
OUT_CLX" & Button_Last_CLX + i).Cells(A, 6) "" Or Worksheets("OUT_CLX" & Button_Last_CLX + i) _
.Cells(A, 12) ""
Worksheets("OUT_CLX" & Button_Last_CLX + i).Rows(A).Clear
A = A + 1
Wend
'*******Copy VBA Code of CLX0_OUT to CLXi_OUT***********
With ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("CLX0_OUT_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("CLX0_OUT_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub CLX0_OUT_Click()" Then
Sub_Code_line_Content = "Private Sub CLX" & Button_Last_CLX + i & " _
_OUT_Click()"
ElseIf Trim(Sub_Code_line_Content) = "clx_name = ""OUT_CLX0""" Then
Sub_Code_line_Content = " clx_name = ""OUT_CLX" & Button_Last_CLX + i & " _
_
ElseIf Trim(Sub_Code_line_Content) = "controller_slot = 14" Then
Sub_Code_line_Content = " controller_slot = " & 14 + (Button_Last_CLX + _
_
i) * 2
ElseIf Trim(Sub_Code_line_Content) = "Zeile_Main = 14" Then
Sub_Code_line_Content = " Zeile_Main = " & 14 + (Button_Last_CLX + i) * _
_
2
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
Next i
ThisWorkbook.Activate
Worksheets("Main").Activate
Application.ScreenUpdating = True
End Sub
Hier die Funktion der Version 11:
Private Sub Add_CLX_Click()
Dim Object_IN As OLEObject
Dim Object_OUT As OLEObject
Dim Tabsheet_IN As Worksheet
Dim Tabsheet_OUT As Worksheet
Dim Eingabeaufforderung
Anzahl = 1
If Anzahl = "" Then Exit Sub
Vorhanden = 0
'****For the buttons in Main:******
For i = 1 To Worksheets("Main").OLEObjects.Count
If Mid(Worksheets("Main").OLEObjects(i).Object.Caption, 1, 3) = "CLX" And InStrRev( _
Worksheets("Main").OLEObjects(i).Object.Caption, "IN") > 0 Then
Button_Last_ID = i
Vorhanden = Vorhanden + 1
End If
If Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_IN" Then
Set Object_IN = Worksheets("Main").OLEObjects(i)
ElseIf Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_OUT" Then
Set Object_OUT = Worksheets("Main").OLEObjects(i)
End If
Next i
Application.ScreenUpdating = False
'Data of the last button:
Button_Last_Top = Worksheets("Main").OLEObjects(Button_Last_ID).Top
Button_Last_Caption = Worksheets("Main").OLEObjects(Button_Last_ID).Object.Caption
Anfang = 4
Laenge = InStr(Button_Last_Caption, "_") - Anfang
Button_Last_CLX = Mid(Button_Last_Caption, Anfang, Laenge)
'****For the buttons in CFG_CHASSIe:******
vorhanden_CFG = 0
For i = 1 To Worksheets("CFG_CHASSI").OLEObjects.Count
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Object.Caption, 1, 12) = "SYM_from_CLX" _
_
Then
Button_CFG_Last_ID = i
vorhanden_CFG = vorhanden_CFG + 1
ElseIf Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Object.Caption, 1, 10) = "SYM_to_CLX" _
_
Then
'Needed for SYM_TO_CLX*, difference between SYM_TO_CLX* and SYM_from_CLX* is .Left
Button_CFG_Last_Right = Worksheets("CFG_CHASSI").OLEObjects(i).Left
End If
Next i
Application.ScreenUpdating = False
For i = 1 To Anzahl
'*******Creating CLX*_IN-Button and Tab***********
Worksheets("Main").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=Object_IN.Left, Top:=Button_Last_Top + Object_IN.Height * i, Width:= _
Object_IN.Width, Height:=Object_IN.Height
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Object.Caption = " _
CLX" & Button_Last_CLX + i & "_IN"
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Name = "CLX" & _
Button_Last_CLX + i & "_IN"
Set Tabsheet_IN = Worksheets("IN_CLX0")
Tabsheet_IN.Copy before:=Worksheets("OUT_E3")
Worksheets("IN_CLX0 (2)").Name = "IN_CLX" & Button_Last_CLX + i
A = 11
While Worksheets("IN_CLX" & Button_Last_CLX + i).Cells(A, 1) "" Or Worksheets(" _
IN_CLX" & Button_Last_CLX + i).Cells(A, 6) "" Or Worksheets("IN_CLX" & Button_Last_CLX + i). _
Cells(A, 12) ""
Worksheets("IN_CLX" & Button_Last_CLX + i).Rows(A).Clear
A = A + 1
Wend
'********Copy VBA Code of CLX0_IN to CLXi_IN***********
With Workbooks(1).VBProject.VBComponents("Tabelle1").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("CLX0_IN_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("CLX0_IN_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines - 2 >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub CLX0_IN_Click()" Then
Sub_Code_line_Content = "Private Sub CLX" & Button_Last_CLX + i & " _
_IN_Click()"
ElseIf Trim(Sub_Code_line_Content) = "Tabelle_in = ""IN_CLX0""" Then
Sub_Code_line_Content = " Tabelle_in = ""IN_CLX" & Button_Last_CLX + i & _
_
ElseIf Trim(Sub_Code_line_Content) = "Zeile_Main = 14" Then
Sub_Code_line_Content = " Zeile_Main = " & 14 + (Button_Last_CLX + i) * _
_
2
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of CLX* column in CFG_CHASSI***********
A = 4
While Worksheets("CFG_CHASSI").Cells(9, A) ""
A = A + 1
Wend
Worksheets("CFG_CHASSI").Columns(A).EntireColumn.Insert
Worksheets("CFG_CHASSI").Columns(A - 1).Copy Destination:=Worksheets("CFG_CHASSI"). _
Columns(A)
Worksheets("CFG_CHASSI").Cells(9, A) = "CLX" & Button_Last_CLX + i
'Data of last Button in CFG:
Button_CFG_Last_Top = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Top
Button_CFG_Last_Height = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Height
Button_CFG_Last_Left = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Left
Button_CFG_Last_Width = Worksheets("CFG_CHASSI").OLEObjects(Button_CFG_Last_ID).Width
'*******Create SYM_from_CLX*-Button***********
Worksheets("CFG_CHASSI").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
_
DisplayAsIcon:=False, Left:=Button_CFG_Last_Left, Top:=Button_CFG_Last_Top + _
Button_CFG_Last_Height * i, Width:=Button_CFG_Last_Width, Height:=Button_CFG_Last_Height
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Object. _
_
Caption = "SYM_from_CLX" & Button_Last_CLX + i & "_to_E3"
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Name = " _
_
SYM_from_CLX" & Button_Last_CLX + i & "_to_E3"
'*******Copy VBA Code of SYM_from_CLX0_to_E3 to SYM_from_CLX*_to_E3***********
With Workbooks(1).VBProject.VBComponents("Tabelle2").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("SYM_from_CLX0_to_E3_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("SYM_from_CLX0_to_E3_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub SYM_from_CLX0_to_E3_Click()" Then
Sub_Code_line_Content = "Private Sub SYM_from_CLX" & Button_Last_CLX + i & " _
_
_to_E3_Click()"
ElseIf Trim(Sub_Code_line_Content) = "CLX_Name = ""IN_CLX0""" Then
Sub_Code_line_Content = " CLX_Name = ""IN_CLX" & Button_Last_CLX + i & "" _
_
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of SYM_to_CLX*-Button and Tab***********
Worksheets("CFG_CHASSI").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
_
DisplayAsIcon:=False, Left:=Button_CFG_Last_Left + Button_CFG_Last_Width, Top:= _
Button_CFG_Last_Top + Button_CFG_Last_Height * i, Width:=Button_CFG_Last_Width, Height:=Button_CFG_Last_Height
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Object. _
_
Caption = "SYM_to_CLX" & Button_Last_CLX + i
Worksheets("CFG_CHASSI").OLEObjects(Worksheets("CFG_CHASSI").OLEObjects.Count).Name = " _
_
SYM_to_CLX" & Button_Last_CLX + i
'*******Copy VBA Code of SYM_to_CLX0 in SYM_to_CLX************
With Workbooks(1).VBProject.VBComponents("Tabelle2").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("SYM_to_CLX0_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("SYM_to_CLX0_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub SYM_to_CLX0_Click()" Then
Sub_Code_line_Content = "Private Sub SYM_to_CLX" & Button_Last_CLX + i & " _
_
_Click()"
ElseIf Trim(Sub_Code_line_Content) = "CFG_Cell = 4" Then
Sub_Code_line_Content = " CFG_Cell = " & 4 + i
ElseIf Trim(Sub_Code_line_Content) = "CLX_OUT = ""OUT_CLX0""" Then
Sub_Code_line_Content = " CLX_OUT = ""OUT_CLX" & i & """"
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
'*******Copy VBA Sub() of SYM_from_CLX0_to_E3 to All_to_E3***********
Sub_Code_lines = .ProcCountLines("All_to_E3_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("All_to_E3_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Ende_der_Sub = False
While Ende_der_Sub = False
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "End Sub" Then
.InsertLines Sub_Code_line, " Call SYM_from_CLX" & Button_Last_CLX + i & _
_
"_to_E3_Click"
Ende_der_Sub = True
End If
Sub_Code_line = Sub_Code_line + 1
Wend
'*******Copy VBA Sub() of SYM_to_CLX* to All_to_CLX***********
Sub_Code_lines = .ProcCountLines("All_to_CLX_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("All_to_CLX_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Ende_der_Sub = False
While Ende_der_Sub = False
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "End Sub" Then
.InsertLines Sub_Code_line, " Call SYM_to_CLX" & Button_Last_CLX + i & " _
_
_Click"
Ende_der_Sub = True
End If
Sub_Code_line = Sub_Code_line + 1
Wend
End With
'*******Creating of CLX* column in CFG_CHASSI***********
A = 2
While Worksheets("CFG_NET_IO").Cells(9, A) ""
A = A + 1
Wend
Worksheets("CFG_NET_IO").Columns(A).EntireColumn.Insert
Worksheets("CFG_NET_IO").Cells(9, A - 1).Copy Destination:=Worksheets("CFG_NET_IO"). _
Cells(9, A)
Worksheets("CFG_NET_IO").Cells(10, A - 1).Copy Destination:=Worksheets("CFG_NET_IO"). _
Cells(10, A)
Worksheets("CFG_NET_IO").Cells(9, A) = "CLX" & Button_Last_CLX + i
'*******Creating CLX*_OUT-Button and Tab***********
Worksheets("Main").OLEObjects.Add ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=Object_OUT.Left, Top:=Button_Last_Top + Object_OUT.Height * i, _
Width:=Object_OUT.Width, Height:=Object_OUT.Height
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Object.Caption = " _
CLX" & Button_Last_CLX + i & "_OUT"
Worksheets("Main").OLEObjects(Worksheets("Main").OLEObjects.Count).Name = "CLX" & _
Button_Last_CLX + i & "_OUT"
Set Tabsheet_OUT = Worksheets("OUT_CLX0")
Tabsheet_OUT.Copy before:=Worksheets("Rev.Info")
Worksheets("OUT_CLX0 (2)").Name = "OUT_CLX" & Button_Last_CLX + i
A = 11
While Worksheets("OUT_CLX" & Button_Last_CLX + i).Cells(A, 1) "" Or Worksheets(" _
OUT_CLX" & Button_Last_CLX + i).Cells(A, 6) "" Or Worksheets("OUT_CLX" & Button_Last_CLX + i) _
.Cells(A, 12) ""
Worksheets("OUT_CLX" & Button_Last_CLX + i).Rows(A).Clear
A = A + 1
Wend
'*******Copy VBA Code of CLX0_OUT to CLXi_OUT***********
With Workbooks(1).VBProject.VBComponents("Tabelle1").CodeModule
Code_Ende = .CountOfLines
Sub_Code_lines = .ProcCountLines("CLX0_OUT_Click", 0)
Sub_Code_Anfang = .ProcBodyLine("CLX0_OUT_Click", 0)
Sub_Code_line = Sub_Code_Anfang
Write_Code_line = Code_Ende + 1
While Code_Ende + Sub_Code_lines - 1 >= Write_Code_line
Sub_Code_line_Content = .Lines(Sub_Code_line, 1)
If Sub_Code_line_Content = "Private Sub CLX0_OUT_Click()" Then
Sub_Code_line_Content = "Private Sub CLX" & Button_Last_CLX + i & " _
_OUT_Click()"
ElseIf Trim(Sub_Code_line_Content) = "clx_name = ""OUT_CLX0""" Then
Sub_Code_line_Content = " clx_name = ""OUT_CLX" & Button_Last_CLX + i & " _
_
ElseIf Trim(Sub_Code_line_Content) = "controller_slot = 14" Then
Sub_Code_line_Content = " controller_slot = " & 14 + (Button_Last_CLX + _
_
i) * 2
ElseIf Trim(Sub_Code_line_Content) = "Zeile_Main = 14" Then
Sub_Code_line_Content = " Zeile_Main = " & 14 + (Button_Last_CLX + i) * _
_
2
End If
.InsertLines Write_Code_line, Sub_Code_line_Content
Write_Code_line = Write_Code_line + 1
Sub_Code_line = Sub_Code_line + 1
Wend
End With
Next i
Workbooks(1).Activate
Worksheets("Main").Activate
Application.ScreenUpdating = True
End Sub
Die einzigsten Veränderungen, die ich getätig habe, sind die Workbooks(1) auf ThisWorkbook geändert um auch keine Probleme zu bekommen wenn ich weitere Exceltabellen offen habe. Weiter habe ich zusätzlich ein paar Buttons hinzugefügt die ich in dieser Funktion mit generieren muss. Und das letzte das ich geändert habe ist das OLEObject.Name welches vorher OLEObject.Object.Caption war. Hier kontrolliere ich nur ob ein Button einen gewissen Namen hat. Bei OLEObject.Object.Caption ist ein Problem aufgetreten als ich eine Datei in das Worksheet eingefügt habe, da wohl diese auch als OLEObject eingefügt wird und kein OLEObject.Object.Caption enthält.
Ich hoffe ihr könnt mir schnell weiterhelfen weil mir reichts langsam -.-
Gruß P.Ockert