Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 16:39:00
ältere VBA Codes automatisch neu strukturieren
20.04.2024 16:36:42
Arbeitsblatt Script auslagern in Modul
20.04.2024 16:28:25
zwei Makro in einem zusammenführen?
20.04.2024 15:30:14
Warum Verweis zeigt Falsch an
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1212to1216
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1212to1216
1212to1216
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

HEUR/Macro.Excel2000

HEUR/Macro.Excel2000
P.Ockert
Hallo ihr,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: HEUR/Macro.Excel2000
03.05.2011 08:36:37
P.Ockert
Also ich weiß an welchen Stellen es liegt hier jeweil gegenübergestellt:
Es ist die eine Änderung um das PDF das ich als Object in die Exceltabelle eingefügt habe, das mit bei diesen Abfragen als ich Caption benutzen wollte einen Fehler gebracht hatte
If Mid(Worksheets("Main").OLEObjects(i).Object.Caption, 1, 3) = "CLX" And InStrRev(Worksheets(" _
Main").OLEObjects(i).Object.Caption, "IN") > 0 Then
If Mid(Worksheets("Main").OLEObjects(i).Name, 1, 3) = "CLX" And InStrRev(Worksheets("Main"). _
OLEObjects(i).Name, "IN") > 0 Then
If Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_IN" Then
If Worksheets("Main").OLEObjects(i).Name = "CLX0_IN" Then
ElseIf Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_OUT" Then
ElseIf Worksheets("Main").OLEObjects(i).Name = "CLX0_OUT" Then
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Object.Caption, 1, 12) = "SYM_from_CLX" Then
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Name, 1, 12) = "SYM_from_CLX" Then

Anzeige
AW: HEUR/Macro.Excel2000
03.05.2011 08:37:30
P.Ockert
Also ich weiß an welchen Stellen es liegt hier jeweil gegenübergestellt:
Es ist die eine Änderung um das PDF das ich als Object in die Exceltabelle eingefügt habe, das mit bei diesen Abfragen als ich Caption benutzen wollte einen Fehler gebracht hatte
If Mid(Worksheets("Main").OLEObjects(i).Object.Caption, 1, 3) = "CLX" And InStrRev(Worksheets(" _
Main").OLEObjects(i).Object.Caption, "IN") > 0 Then
If Mid(Worksheets("Main").OLEObjects(i).Name, 1, 3) = "CLX" And InStrRev(Worksheets("Main"). _
OLEObjects(i).Name, "IN") > 0 Then
If Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_IN" Then
If Worksheets("Main").OLEObjects(i).Name = "CLX0_IN" Then
ElseIf Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_OUT" Then
ElseIf Worksheets("Main").OLEObjects(i).Name = "CLX0_OUT" Then
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Object.Caption, 1, 12) = "SYM_from_CLX" Then
If Mid(Worksheets("CFG_CHASSI").OLEObjects(i).Name, 1, 12) = "SYM_from_CLX" Then

Anzeige
AW: HEUR/Macro.Excel2000
03.05.2011 12:05:16
fcs
Hallo P.Ockert
Es ist die eine Änderung um das PDF das ich als Object in die Exceltabelle eingefügt habe, das mit bei diesen Abfragen als ich Caption benutzen wollte einen Fehler gebracht hatte
Ein PDF als OLE-Objekt hat keine Caption-Eigenschaft, dadurch kommt es zum Fehler.
Du müsstest also bei der ursprünglichen Version bleiben, in der nur der Objektname angepasst wird, oder entsprechende Prüfungen anpassen/ergänzen.
Gruß
Franz
Codebeispiel: 
Private Sub CommandButton1_Click()
Dim oOleobject As OLEObject
On Error GoTo Fehler
Set oOleobject = ActiveSheet.OLEObjects(Me.OLEObjects.Count)
MsgBox "Commandbutton-Name: " & oOleobject.Name
MsgBox "Commandbutton-Caption: " & oOleobject.Objekt.Caption
oOleobject.Name = "PDF0009"
oOleobject.Objekt.Caption = "PDF0009"
MsgBox "Commandbutton-Name: " & oOleobject.Name
MsgBox "Commandbutton-Caption: " & oOleobject.Object.Caption
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 438
Resume Next 'oder andere Resume Methode
Case 1004
Resume Next 'oder andere Resume Methode
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: HEUR/Macro.Excel2000
03.05.2011 14:13:17
P.Ockert
Okay gut nach weiterm Forschen ist mir aufgefallen dass es nur diese der ganzen Abfragen ist die den Virus auslöst:
If Worksheets("Main").OLEObjects(i).Object.Caption = "CLX0_IN" Then
If Worksheets("Main").OLEObjects(i).Name = "CLX0_IN" Then
Was mich wundert da ich diese Abfrage in einem anderen XLS-File auch habe und dort keine Viruswarnung bewirkt. Ich frag mich nur ob es an meinem Code liegt oder wirklich nur am Antivir. Weil das Problem ist halt ein geschäftliches Programm und wenn ich es auf dem Netz ablegen will wird es sofort wieder entfernt dank Virenscanner.
Anzeige
AW: HEUR/Macro.Excel2000
03.05.2011 14:47:26
fcs
Hallo P.Ockert,
mit virensensiblen VBA-Makros und man eine Reaktion des Virenscanners ggf. vermeidet kenne ich mich nicht aus.
Im Extremfall müßte man sich hier mal mit dem Hersteller des Virenprogramms in Verbindung setzten.
Die 2 Code-Zeilen machen auf mich jedenfalls nicht den Eindruck, dass sie schädlichen Aktionen auslösen könnten.
Generell wäre für mich aber fast jeder VBA-Code suspekt, der VBA-Code manipuliert. Immerhin muss man ja bei deinem Code in Excel den Zugriff auf das VBA-Modul erlauben.
Gruß
Franz

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige