AW: Fehlersuche
26.01.2009 16:36:00
adrian
Hi,
Es funktioniert nun =)
DOCH habe ich immer noch ab und zu mal eine Fehlermeldung:
Run-time error '-2147319764 (8002802c)':
Method 'Name' of Object 'IMdc Text' failed
Das Problem hatte ich vorher schon, d.h. es liegt nicht zwangsweise an der Namensvergebung der Listen!
Ich meine es hat mit dem Aufruf von AddingTextbox Cell.Offset(2, 0), ODMSum etwas zu tun.
Ich habe alle Variablen überprüft und Sie haben keine Keyword Eigenschaft!
Im Hauptblatt werden die erstellten Objekte bevor sie neu generiert werden, mit den Beiden letzten Funktionen gelöscht. Quasi steht weiter oben im Syntax einfach "DelteTextBox" und "DeleteListbox"
kann es am Fkt.-Namen liegen?
lg
adrian
hier nochmal die aufgerufenen Funktionen:
Sub AddAccessWindow(Stelle As Range, OEMNamen As Variant, ODMName As String)
Dim i As Integer, ArrAccessReturn As Variant
For OBCount = 0 To 3
If OEMNamen(OBCount) "" Then
ReDim ArrAccessReturn(0 To 2)
With ActiveSheet
Set Objekt = .OLEObjects.Add(ClassType:="Forms.ListBox.1", Left:=Stelle.Left, _
Top:=Stelle.Top, Width:=Stelle.Width, Height:=Stelle.Height)
Set LB = Objekt.Object
With LB
.Name = ODMName & "AccessBox" & OEMNamen(OBCount)
.IntegralHeight = False
.Width = 200
.Height = 65
.TextAlign = fmTextAlignLeft
.BorderStyle = fmBorderStyleSingle
.ListStyle = fmListStylePlain
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
.SpecialEffect = fmSpecialEffectFlat
.MultiSelect = fmMultiSelectSingle
.Shadow = True
ArrAccessReturn = ResultControls(OEMNamen(OBCount), ODMName)
For i = 0 To 2
If ArrAccessReturn(i) "" Then
.AddItem ArrAccessReturn(i)
End If
Next
End With
Set Stelle = Stelle.Offset(6, 0)
End With
End If
Next OBCount
End Sub
Sub AddingTextbox(Stelle As Range, ODMSum As Double)
With ActiveSheet
Set Objekt = .OLEObjects.Add(ClassType:="Forms.TextBox.1", Left:=Stelle.Left, _
Top:=Stelle.Top, Width:=Stelle.Width, Height:=Stelle.Height)
Set TB = Objekt.Object
With TB
.Name = "ODMVolumeBox" & ActiveSheet.OLEObjects.Count
.Width = 120
.Height = 25
.TextAlign = fmTextAlignCenter
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
.Value = ODMSum
End With
End With
End Sub
Sub AddingListBox(Stelle As Range, OEMNamen As Variant)
Dim i As Integer
With ActiveSheet
Set Objekt = .OLEObjects.Add(ClassType:="Forms.ListBox.1", Left:=Stelle.Left, _
Top:=Stelle.Top, Width:=Stelle.Width, Height:=Stelle.Height)
Set LB = Objekt.Object
With LB
.Name = "ODMList" & ActiveSheet.OLEObjects.Count
.IntegralHeight = False
.Width = 120
.Height = 50
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
.ListStyle = fmListStylePlain
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
.SpecialEffect = fmSpecialEffectFlat
.MultiSelect = fmMultiSelectSingle
.Shadow = True
For i = 0 To 3
If OEMNamen(i) "" Then
.AddItem OEMNamen(i)
End If
Next
End With
End With
End Sub
Function ResultControls(ByVal WKS As String, ByVal GRP As String) As Variant
Dim Ending As Variant, Identifier As Variant, i As Integer, VarResult As Variant, Marked As String, Business As String, AccessValue As String
Ending = Array(" (US)", " (EU)", " (A)")
Identifier = Array("US = ", "EU = ", "Asia = ")
ReDim VarResult(0 To 2)
For i = 0 To 2
For Each Objekt In Worksheets(WKS & Ending(i)).OLEObjects
If Objekt.progID = "Forms.OptionButton.1" Then
If InStr(Objekt.Object.GroupName, "FC" & GRP) Then
If Objekt.Object.Value Then
AccessValue = Objekt.Object.Caption
Marked = "Yes"
End If
Business = "Yes"
End If
End If
Next Objekt
If Marked = "Yes" Then
VarResult(i) = Identifier(i) & AccessValue
Else
VarResult(i) = Identifier(i) & "Not marked!"
End If
If Business "Yes" Then
VarResult(i) = Identifier(i) & "No " & GRP & " business!"
End If
Next
ResultControls = VarResult
End Function
Private Function SearchOEM(ODMArea As Range, ODMName As String, OEMName As String) As String
Dim Zelle As Range, Found As String
For Each Zelle In ODMArea
If Zelle.Value = ODMName Then
Found = "Yes"
SearchOEM = OEMName
End If
Next
If Found "Yes" Then SearchOEM = Empty
End Function
Sub DeleteTextBox()
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ODMVolumeBox") Then Objekt.Delete
Next Objekt
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "AccessBox") Then Objekt.Delete
Next Objekt
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "TextBox") Then Objekt.Delete
Next Objekt
End Sub
Sub DeleteListBox()
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ODMList") Then Objekt.Delete
Next Objekt
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ListBox") Then Objekt.Delete
Next Objekt
End Sub