AW: die Methode Value für... Fehlermeldung
09.03.2023 21:59:50
Elle
Hallo Ralf, das hat leider nicht funktioniert der Fehler wird mir dann bei .Value = i + 1angezeigt
Hier ist die UserForm1 (ohne die Neuerung):
Private Sub cb_speichern_Click()
Dim i As Integer
If WerteBerechnet = False Then
MsgBox "Bitte zuerst eine Rechnung ausführen", vbCritical
Else
Worksheets("Tabelle1").Select
Range("A2").Select
Anzahl = 1
While Selection.Value > ""
Selection.Offset(1, 0).Select
Anzahl = Anzahl + 1
Wend
Selection.Value = Anzahl
Selection.Offset(0, 1).Value = tb_Länge.Value
Selection.Offset(0, 2).Value = tb_Breite.Value
Selection.Offset(0, 3).Value = tb_Höhe.Value
Selection.Offset(0, 4).Value = tb_Winkel.Value
Selection.Offset(0, 5).Value = CDbl(tb_A1.Value)
Selection.Offset(0, 6).Value = l
Selection.Offset(0, 7).Value = CDbl(tb_VolBodenplatte.Value)
Selection.Offset(0, 8).Value = CDbl(tb_VolMauer.Value)
Selection.Offset(0, 9).Value = CDbl(tb_VolGesamt.Value)
WerteBerechnet = False
End If
End Sub
Private Sub UserForm_Activate()
'Konstante beim ersten Öffnen festlegen
d = 0.2
End Sub
Private Sub tb_Höhe_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Höhenwert aus Formular einlesen und auf Eingabegrenzen prüfen
WerteBerechnet = False 'Wert wurde geändert, Berechnung erforderlich
If tb_Höhe.Value >= 1 Then 'Minimal gültige Eingabe
Else: MsgBox " Minimalwert der Höhe von 1m unterschritten", vbCritical 'sonst Wert zu klein Melden
tb_Höhe.SetFocus
tb_Höhe.Value = 1 'Mindestwert speichern
End If
If tb_Höhe.Value = 10 Then 'Maximal gültige Eingabe
Else
MsgBox "Maximalwert der Höhe 10m überschritten", vbCritical 'sonst Wert zu groß melden
tb_Höhe.SetFocus
tb_Höhe.Value = 10 'Maximalwert speichern
End If
End Sub
Private Sub tb_Breite_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Breite der Bodenplatte aus Formular einlesen und Eingabegrenzen prüfen
WerteBerechnet = False 'Wert wurde geändert Berechnung erforderlich
If tb_Breite.Value >= 1 Then 'Minimal gültige Eingabe
Else
MsgBox "Minimalwert der Länge 1m unterschritten", vbCritical 'sonst Wert zu klein melden
tb_Breite.SetFocus
tb_Breite.Value = 1 'Mindestwert speichern
End If
If tb_Breite.Value = 5 Then 'Maximal gültige Eingabe
Else
MsgBox "Maximalwert der Länge von 5m überschritten", vbCritical 'sonst Wert zu groß Melden
tb_Breite.SetFocus
tb_Breite.Value = 5 ' Maximalwert speichern
End If
End Sub
Private Sub tb_Länge_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Länge der Bodenplatte aus Formular einlesen und Eingabegrenzen prüfen
WerteBerechnet = False 'Wert wurde geändert Berechnung erforderlich
If tb_Länge.Value >= 1 Then 'Minimal gültige Eingabe
Else
MsgBox "Minimalwert der Länge 1m unterschritten", vbCritical 'sonst Wert zu klein melden
tb_Länge.SetFocus
tb_Länge.Value = 1 'Mindestwert speichern
End If
If tb_Länge.Value = 5 Then 'Maximal gültige Eingabe
Else
MsgBox "Maximalwert der Länge 5m überschritten", vbCritical 'sonst Wert zu groß melden
tb_Länge.SetFocus
tb_Länge.Value = 5 'Maximalwert speichern
End If
tb_A1.Value = tb_Länge * 0.2 'Abstand Mauer zu Vorderkant Bodenplatte
End Sub
Private Sub tb_Winkel_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Winkel der Mauerposition aus Formular einlesen und auf Eingabegrenzen prüfen
WerteBerechnet = False 'Wert wurde geändert BErechnung erforderlich
If tb_Winkel.Value >= 0 Then 'Minimal gültige Eingabe
Else
MsgBox "Minimalwert von 0° unterschritten", vbCritical 'sonst Wert zu klein melden
tb_Winkel.SetFocus
tb_Winkel.Value = 0 'Minimalwert speichern
End If
If tb_Winkel.Value = 180 Then 'Maximal gültige Eingabe
Else
MsgBox "Maximalwert von 180° überschritten", vbCritical 'sonst Wert zu groß melde
tb_Winkel.SetFocus
tb_Winkel.Value = 180 'Maximalwert speichern
End If
End Sub
Function VolumenFundament(a, b) As Double
V1 = a * b * d
'Berechnet das Volumen des Fundamentes
VolumenFundament = V1
End Function
Function VolumenMauer(a As Double, b As Double, alpha As Double, h As Double, A1 As Double) As Double
'Berechnet das Volumen der Mauer
Dim AlphaRad As Double
'Eingabewinkel Alpha in Berechnungswinkel umwandeln
'Eingabewinkel wird dabei um 90° gedreht und anschliesend für Berechnung im Bogenmaß umgewandelt
AlphaRad = (alpha - 90) * (WorksheetFunction.Pi() / 180)
'Berechnung der LÄnge l der Mauer
If alpha >= 90 Then '1.Fall: Winkeleingabe ist zwischen 90 und 180 Grad
If b * Tan(AlphaRad) >= a - A1 Then 'und Hyponthenuse C des Hilfsdreiecks schneidet die obere Seite b
l = (a - A1) / (Sin(AlphaRad)) 'Seite A des Hilfsdreiecks ist a-A1
Else
l = b / (Cos(AlphaRad)) 'sonst 2.Fall: Seite B des HIlfsdreicks ist immer b
End If
Else ' 3.Fall: Winkeleingabe ist kleiner als 90 Grad
If b * Tan(Abs(AlphaRad)) = A1 Then 'und Hypothenuse des Hilfsdreiecks schneidet die b Seite
l = b / Cos(Abs(AlphaRad)) 'Seite B des Hilfsdreiecks ist immer b
Else
l = A1 / Sin(Abs(AlphaRad)) 'sonst 4.Fall: Seite a des Hilfdreiecks ist immer A1
End If
End If
'Volumenberechnung
VolumenMauer = Round(l * d * h, 3)
End Function
Private Sub cb_berechnen_Click()
tb_VolBodenplatte = VolumenFundament(CDbl(tb_Länge.Value), CDbl(tb_Breite.Value))
tb_VolMauer = VolumenMauer(CDbl(tb_Länge.Value), CDbl(tb_Breite.Value), CDbl(tb_Winkel.Value), CDbl(tb_Höhe.Value), CDbl(tb_A1.Value))
tb_VolGesamt.Value = CDbl(tb_VolBodenplatte) + CDbl(tb_VolMauer)
WerteBerechnet = True
End Sub
Userform2:
Private Sub cb_bearbeiten_Click()
Dim tb_Länge As Double
Dim tb_Breite As Double
Dim tb_Höhe As Double
Dim tb_Winkel As Double
Dim tb_A1 As Double
UserForm1.tb_Länge.Value = lb_LfdNr.List(lb_LfdNr.ListIndex, 1)
UserForm1.tb_Breite.Value = lb_LfdNr.List(lb_LfdNr.ListIndex, 2)
UserForm1.tb_Höhe.Value = lb_LfdNr.List(lb_LfdNr.ListIndex, 3)
UserForm1.tb_Winkel.Value = lb_LfdNr.List(lb_LfdNr.ListIndex, 4)
UserForm1.tb_A1.Value = lb_LfdNr.List(lb_LfdNr.ListIndex, 5)
UserForm1.Show
End Sub
Private Sub UserForm_Activate()
'allgemeine Einstellungen
'Überschriften
lb_LfdNr.ColumnHeads = True
'Spaltenanzahl
lb_LfdNr.ColumnCount = 10
'Spaltenbreite
lb_LfdNr.ColumnWidths = "30;60;60;60;60;60;60;80;60;60;"
'Listbox mit we
lb_LfdNr.RowSource = Tabelle1.Range("Bauwerkdaten").Address
'Spalte auswählen können
lb_LfdNr.ListStyle = fmListStyleOption
End Sub