Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1036to1040
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
Inhaltsverzeichnis

Finde Fehler nicht! Hilfe!

Finde Fehler nicht! Hilfe!
13.01.2009 13:20:46
adrian
Hallo,
ich finde den Fehler einfach nicht =( Bitte um Hilfe!
habe folgendes vor:
Habe in diversen Bereichen Namen gespeichert unter denen zugehörige Werte gespeichert sind.
Für jeden gleichen Namen in den Bereichen möchte ich deren zugehörige Werte Summieren und anschließend in eine Zugehörige Textbox, die zuvor erstellt wurde, einlesen!
Für jeden Namen wird eine TextBox erstellt. In "ODMList" sind alle Namen enthalten.
Folgend habe ich das gedacht:
Bitte auch gerne um verbesserungsvorschläge =)
lg
adrian
Abschnitt im Hauptsheet:
For Each Cell In range("ODMListB")
ODMSum = 0
If Cell.Value "" Then
AddTextbox Cell.Offset(2, 0), Cell.Value
SearchODMValue Worksheets("Overview").range("PhilipsODM"), Cell.Value
SearchODMValue Worksheets("Overview").range("SonyODM"), Cell.Value
SearchODMValue Worksheets("Overview").range("SamsungODM"), Cell.Value
FillTextBox Cell.Value, ODMSum
End If
Next
Suchfunktion:

Private Sub SearchODMValue(SearchArea As range, Name As String)
For Each Cell In SearchArea
If Cell.Value = Name Then
ODMSum = ODMSum + Cell.Offset(5, 0).Value
End If
Next
End Sub


Füllfunktion:


Sub FillTextBox(Name As String, ODMSum As Double)
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ODMVolumeBox" & Name) Then
Set TB = Objekt.Object
With TB
.Value = ODMSum
End With
End If
Next
End Sub


10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Finde Fehler nicht! Hilfe!
13.01.2009 14:44:34
adrian
bezieht sich auf vorherige Nachricht
Muss irgendwie daran liegen, dass Byref nicht so einfach funktioniert hier?!
Würde gerne ODMSum, einfach folgend übergeben:
SearchODMValue Worksheets("Overview").range("PhilipsODM"), Cell.Value, ODMSum
ginge das?
AW: Finde Fehler nicht! Hilfe!
13.01.2009 14:45:00
adrian
bezieht sich auf vorherige Nachricht
Muss irgendwie daran liegen, dass Byref nicht so einfach funktioniert hier?!
Würde gerne ODMSum, einfach folgend übergeben:
SearchODMValue Worksheets("Overview").range("PhilipsODM"), Cell.Value, ODMSum
ginge das?
AW: Finde Fehler nicht! Hilfe!
13.01.2009 15:45:53
dirk
Hallo!
Was genau funktioniert denn nicht? Wo steigt der VBA editor aus und welche FML kommt?
In deiner fuellfunktion hast du SetTB = Objekt.object gesetzt. Das erste Objekt mit K Ist das definiert?
Gruss
Dirk aus Dubai
Anzeige
AW: Finde Fehler nicht! Hilfe!
14.01.2009 10:24:12
adrian
Hi,
Es kommt folgende Fehlermeldung:
Run time error '91':
Object Variable or with Block Variable not set
irgendwo ist der Wurm drin =/
lg
adrian
Habe es wie folgt deklariert:
Dim TB As MSForms.TEXTBOX
Dim Objekt As OLEObject, ODMSum As Double, Cell As Range
Funktion für erstellen der Textbox und Füllfunktion:
Sub AddTextbox(Stelle As Range, Name As String)
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" & Name & ActiveSheet.OLEObjects.Count
.Width = 120
.Height = 25
.TextAlign = fmTextAlignCenter
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
End With
End With
End Sub


Sub FillTextBox(Name As String, ODMSum As Double)
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ODMVolumeBox" & Name) Then
Set TB = Objekt.Object
With TB
.Value = ODMSum
End With
End If
Next
End Sub


SuchFunktion:


Private Function SearchODMValue(SearchArea As Range, Name As String) As Double
For Each Cell In SearchArea
If Cell.Value = Name Then
SearchODMValue = SearchODMValue + Cell.Offset(5, 0).Value
End If
Next
End Function


Aufruf:
For Each Cell In Range("ODMListB")
ODMSum = 0
If Cell.Value "" Then
AddTextbox Cell.Offset(2, 0), Cell.Value
ODMSum = SearchODMValue(Worksheets("Overview").Range("PhilipsODM"), Cell.Value)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SonyODM"), Cell.Value)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SamsungODM"), Cell.Value)
FillTextBox Cell.Value, ODMSum
End If
Next

Anzeige
AW: Finde Fehler nicht! Hilfe!
13.01.2009 15:49:00
fcs
Hallo Adrian,
bei dir ist die Code-Syntax für das Erstellen der Textbox einfach nicht korrekt.
Nachfolgend mein Vorschlag für die Umsetzung.
Gruß
Franz

Sub Test()
Dim cell As Range, objShape As Shape
Dim ODMSum As Double
On Error GoTo Fehler
For Each cell In Range("ODMListB")
ODMSum = 0
If cell.Value  "" Then
'Textbox einfügen 2 Zeilen unterhalb Zelle
Set objShape = ActiveSheet.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=cell.Offset(2, 0).Left, _
Top:=cell.Offset(2, 0).Top, _
Height:=cell.Offset(2, 0).Height, _
Width:=cell.Offset(2, 0).Width)
'Textbox umbenennen
objShape.Name = "ODMVolumeBox" & cell.Value
'Namen auswerten und Summen berechnen
ODMSum = SearchODMValue(Worksheets("Overview").Range("PhilipsODM"), cell.Value)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SonyODM"), cell.Value)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SamsungODM"), cell.Value)
'Summe in Textbox eintragen und Textbox formatieren
With objShape.TextFrame
.Characters.Text = Format(ODMSum, "#,##0.00")
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End If
Next
Fehler:
With Err
If .Number  0 Then
Select Case .Number
Case 70 'Textbox mit name existiert schon
MsgBox "Fehler-Nr. : " & .Number & vbLf & .Description & vbLf _
& "Textbox mit dem Namen ""ODMVolumeBox" & cell.Value & """ existiert bereits!" _
& vbLf & "Erstellte Textbox wird nicht umbenannt!"
Resume Next
Case Else
MsgBox "Fehler-Nr. : " & .Number & vbLf & .Description
End Select
End If
End With
End Sub
'Suchfunktion:
Private Function SearchODMValue(SearchArea As Range, Name As String) As Double
Dim cell As Range
For Each cell In SearchArea
If cell.Value = Name Then
SearchODMValue = SearchODMValue + cell.Offset(5, 0).Value
End If
Next
End Function


Anzeige
AW: Finde Fehler nicht! Hilfe!
14.01.2009 09:43:59
adrian
Hi,
meine Textbox erstelle ich ja fogendermaßen:
Die FillFunktion ist nur zum Namen eintragen gedacht! müsste schon stimmen =/
Es funktioniert ja auch wenn ich in der FillFunktion einfach nur eine Null eintragen lasse.
Möchte auch den Parameter "ODMSum" an die Searchfunktion übergeben, wenns ginge =)
Experimentiere mal bisschen mit deinem Bsp. rum.
Danke dir schon mal!
lg
adrian
Dim TB As MSForms.TEXTBOX
Dim Objekt As OLEObject

Sub AddTextbox(Stelle As Range, Name As String)
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" & Name & ActiveSheet.OLEObjects.Count
.Width = 120
.Height = 25
.TextAlign = fmTextAlignCenter
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
End With
End With
End Sub



Sub FillTextBox(Name As String, ODMSum As Double)
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "ODMVolumeBox" & Name) Then
Set TB = Objekt.Object
With TB
.Value = ODMSum
End With
End If
Next
End Sub


Anzeige
AW: Finde Fehler nicht! Hilfe!
14.01.2009 11:54:01
adrian
Hi,
Habe mal folgendes Probiert:
Die Suchfunktion wie du geschrieben hast.
Die AddTextboxFunktion so:

Sub AddTextbox(Stelle As Range, Name As String, Sum 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" & Name & ActiveSheet.OLEObjects.Count
.Width = 120
.Height = 25
.TextAlign = fmTextAlignCenter
.Font = "Georgia"
.Font.Bold = True
.Font.Size = 16
.Value = Sum
End With
End With
End Sub


Den Aufruf im Sheet so:
For Each Cell In Range("ODMListB")
ODMSum = 0
If Cell.Value "" Then
Name = Cell.Value
Position = Application.Range(Cell.Offset(2, 0))
ODMSum = SearchODMValue(Worksheets("Overview").Range("PhilipsODM"), Name)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SonyODM"), Name)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SamsungODM"), Name)
AddTextbox Position, Name, ODMSum
End If
Next
Jetzt will er einfach nicht mehr die Stelle an die AddTextboxFunktion Übergeben > Vorhin (Siehe Oben) hat Addtextbox Cell.Offset(2, 0) noch funktioniert!
Habe das Gefühl das wenn ich mehr als nur die Stelle übergeben will, das zum Geier warum auch immer nicht mehr funktioniert =(
habe es mit Position = Application.Range(Cell.Offset(2, 0)) probiert.... geht auch nicht!
immer diese Fehlermeldung:
Run Time Error '91':
Object Variable or With Block Variable not set
eine Idee warum das nicht klappt?!
lg
adrian

Anzeige
AW: Finde Fehler nicht! Hilfe!
14.01.2009 13:20:00
fcs
Hallo Adrian,
Die Variable Position muss als Range deklariert sein und mit Set der zugehörige Bereich zugewiesen werden. Bei Dir wird zur Zeit der Variablen der Wert der Zelle "Application.Range(Cell.Offset(2, 0))" zugewiesen.
Set Position = Application.Range(Cell.Offset(2, 0))
Gruß
Franz
PS: Kleiner Tipp: Verwende als Variablen möglichst nicht Bezeichnungen, die VBA als Methoden oder Eigenschaften verwendet. Das kann ggf. zu Komplikationen führen. Bei Dir z.B. die variable "Name" oder "Sum"
AW: Finde Fehler nicht! Hilfe!
14.01.2009 14:04:00
adrian
Hi Franz =)
hab es rausgefunden woran es lag!
1. war wie du sagst die zuweisung für position falsch!
2. aber auch wenn das richtig gewesen wäre, hätte es noch nicht gefunzt, da ich Seppl in der Suchfunktion auch Cell verwendete und diese Variable generell deklariert habe (ganz oben).
Somit ist in den Funktionsaufrufen Cell immer verändert worden und bei dem Aufruf: (siehe fett)
For Each Cell In Range("ODMListB")
ODMSum = 0
If Cell.Value "" Then
Name = Cell.Value
ODMSum = SearchODMValue(Worksheets("Overview").Range("PhilipsODM"), Name)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SonyODM"), Name)
ODMSum = ODMSum + SearchODMValue(Worksheets("Overview").Range("SamsungODM"), Name)
AddTextbox Cell.Offset(2, 0), Name, ODMSum
End If
Next
....hat sich der Bezug von Cell Komplett geändert und nicht mehr mit dem von "ODMListB" übereingestimmt!
Danke für deinen Tipp und für deine Hilfe =)
lg
adrian
Anzeige
erledigt oT
14.01.2009 14:56:36
zu
zu

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige