AW: Dateneingabe+Berechnung in Box?
13.06.2006 00:08:35
fcs
Hallo Spillo,
diese beiden Makros müssen noch angepaßt werden:
im Modul:
Sub Schaltfläche4_BeiKlick()
Dim wks As Worksheet, Zeile As Long, Zeilenmax As Long, Zeile1 As Long, rngAnzahl As Range
' Nach folgender Abfrage wird eine neue Rezept-Zusammenstellung angehängt oder
' die vorhandene Liste gelöscht und neu begonnen.
Zeilenmax = 30 ' Max. Zeilenzahl für Zusammenstellung mehrerer Rezepte
Zeile1 = 11 '1. Zeile ab der Ergebnisse aus dem userform in die Tabelle eingetragen werden
' Bereich mit der Anzahl der Inhaltsstoffe je Rezept
Set rngAnzahl = Application.Range("alleRezepteX")
Set wks = ThisWorkbook.Sheets("Formular")
With wks
Zeile = .Cells(65536, "A").End(xlUp).Row + 1
If MsgBox("Weiteres Rezept in Liste anfügen?" & vbLf & vbLf _
& " Bei 'Nein' wird die vorhandene Auflistung gelöscht!", _
vbYesNo + vbQuestion, "Rezept zusammenstellen") = vbNo Then
.Range(.Cells(Zeile1, "A"), .Cells(.Cells(65536, "A").End(xlUp).Row + 1, "C")).ClearContents
.Range(.Cells(Zeile1, "A"), .Cells(Zeile1 + Zeilenmax, "A")).HorizontalAlignment = xlCenter
Else
If Zeile1 + Zeilenmax < Zeile + rngAnzahl(1, Application.Range("RezeptNr")) Then
MsgBox ("Rezept hat zu viele Zeilen! Makro wird abgebrochen.")
Exit Sub
End If
End If
'Nächste freie Zeile suchen
End With
UserForm1.Show
End Sub
Im userform:
Private Sub cbOK_Click()
Dim iI As Integer, wks As Worksheet, Zeile As Long
' Werte in Tabelle eintragen
Set wks = ThisWorkbook.Sheets("Formular")
With wks
'Nächste freie Zeile suchen
Zeile = .Cells(65536, "A").End(xlUp).Row + 1
.Cells(Zeile, 1).Value = "Zusammenstellung " & Format(Application.Range("Gesamtmenge"), "#,##0") & _
" " & Application.Range("Einheit") & " mit Rezept Nr. " & Application.Range("RezeptNr")
.Cells(Zeile, 1).HorizontalAlignment = xlLeft
For iI = 1 To AnzInhalt
If Val(Me.Controls("tbMenge" & Format(iI, "00")).Value) > 0 Then
Zeile = Zeile + 1
.Cells(Zeile, 1).Value = Val(Me.Controls("tbNr" & Format(iI, "00")).Value)
.Cells(Zeile, 2).Value = Me.Controls("tbBeschreibung" & Format(iI, "00")).Value
.Cells(Zeile, 3).Value = CDbl(Me.Controls("tbMenge" & Format(iI, "00")).Value)
End If
Next iI
End With
Unload UserForm1
End Sub
mfg
Franz