| Autor |
Suche Leute die sich mit VB/VBA auskennen |
Partyboy02
39 Jahre
männlich |
von Partyboy02 am 23.11.2006 um 12:24 Uhr:
Hallo
Das programm was ich geschrieben habe ist zwar OK.
Aber leider habe ich nun noch 2 Schönheitsfehler.
Von den gewünschten Funktionen her klappt es wunderbar, aber ....
also er trägt alle Daten aus Excel in die Wordtabelle ein und Berechnet auch richtig den Gesamtpreis
wenn eine Ware leer oder in geringerer stückzahl als angegeben vorhanden ist dann gibt er die Meldung und sagt das nurnoch x vorhanden sind und das man doch die Ware y nachbestellen soll
Problem ist nun das er dann aber trotzdem mit der Schleife weitermacht
Ich weiß nun leider nicht wie ich ihm sage das er nach der Meldung einfach aussteigen soll und auf erneute eingabe warten soll (denke das irgendwie mit goTo gehen könnte)
Weiteres Problem ist das er nicht am Anfang der Tabelle anfängt einzutragen, sondern lustigerweise in der mitte der Tabelle und dann füllt er von oben auf bis die tabelle voll ist
wenn die Tabelle voll ist stürzt das Programm natürlich auch wieder ab
Wie geht es das er die Tabelle erweitert???
Oder soll ich einfach das Programm dann mit einem END killen und dann hat man ja seine Rechnung.
Aber wie mache ich ihm klar das er erst wenn die Tabelle voll ist das Programm killen soll???
der code von dem ganzen spaß:
Code:
Dim dateiauswahl
Dim xl As Object
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim ol As Object
Dim namen() As String
Dim Bereich As Object
Dim Einzel As Integer
Dim Menge As Integer
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim gesamtpreis As Integer
Private Sub UserForm_Activate()
'Datei-Öffnen Dialog zur Auswahl der Excel Datei
'Set Dialog = CreateObject("MSComDlg.CommonDialog")
'On Error Resume Next
'With Dialog
' .Filter = "Excel (*.xls)|*.xls"
' .DialogTitel = "Datei öffnen"
' .MaxFileSize = 260
' .InitDir = "C:"
' .ShowOpen
' If Err = 0 Then
' MsgBox "Ausgewälte Datei: " & .FileName
' End If
dateiauswahl = "C:\waren.xls"
' End With
'##Combobox mit Inhalten aus Excel füllen##
Set xl = CreateObject("excel.Application")
xl.workbooks.Open ("C:\waren.xls")
ComboBox1.Clear
Set Bereich = xl.worksheets(1).[A1].CurrentRegion
For i = 2 To Bereich.Rows.Count
ComboBox1.AddItem xl.worksheets(1).Cells(i, 1).Value
Next
ComboBox1.Value = ComboBox1.List(0)
Set wdApp = CreateObject("word.Application")
End Sub
Private Sub ComboBox1_Change()
'##Lagerbestand in Textfeld eintragen##
a = ComboBox1.ListIndex + 2
TextBox1.Text = xl.worksheets(1).Cells(a, 2).Value
End Sub
Private Sub WareBuchen_Click()
'##Benötigte Ware aus Lagerbestand ausbuchen und in Worddokument eintragen (Bezeichnung, Menge, Einzelpreis und Gesamtpreis)##
gesamtpreis = xl.worksheets(1).Cells(a, 3).Value
TextBox1.Text = TextBox1.Text - TextBox2.Text
If TextBox1.Text < 0 Or TextBox1.Text < TextBox2.Text Then
MsgBox "Nicht genügend Ware vorhanden! Nurnoch " & xl.worksheets(1).Cells(a, 2).Value & " Stück vorhanden Bitte bestellen Sie umgehend " & ComboBox1.Value & " nach", vbCritical, "FEHLER"
'Hier ein Abbruch einfügen damit nicht weitergerechnet wird
Else:
a = ComboBox1.ListIndex + 2
xl.worksheets(1).Cells(a, 2).Value = TextBox1.Text
TextBox1.Text = xl.worksheets(1).Cells(a, 2).Value
End If
' Do While c = False
'If ActiveDocument.Tables(1).Cell(a, 1).Range.Text = vbCr & Chr(7) Then
' c = True
'Else
b = b + 1
'End If
'Loop
ActiveDocument.Tables(1).Cell(a, 1).Range.Text = TextBox2.Text
ActiveDocument.Tables(1).Cell(a, 2).Range.Text = xl.worksheets(1).Cells(a, 1).Value
ActiveDocument.Tables(1).Cell(a, 3).Range.Text = xl.worksheets(1).Cells(a, 3).Value
ActiveDocument.Tables(1).Cell(a, 4).Range.Text = gesamtpreis * TextBox2.Text
' c = False
End Sub
Private Sub Rechnungssumme_Click()
'##Rechnungsbetrag berechnen##
End Sub
Private Sub Ende_Click()
xl.workbooks(1).Save
xl.Quit
Set xl = Nothing
End
End Sub
Private Sub UserForm_Terminate()
xl.workbooks(1).Save
xl.Quit
Set xl = Nothing
End Sub
wenn jemand weitere fehler im Code auffallen dann bin ich auch sehr froh wenn man mir das sagt
|
gelöschter
Benutzer
|
von am 23.11.2006 um 12:49 Uhr:
was willst du denn genau wissen??ich kenne mich excel sehr gut aus??
|
Lordares
44 Jahre
männlich |
von Lordares am 23.11.2006 um 12:50 Uhr:
@u.a. eyelesse:
wer sich hiermit nicht auskennt oder hier nichts konstruktives beitragen kann, der möge bitte schweigen anstatt hier nur mist von sich zu geben. danke.
|
gelöschter
Benutzer
|
von am 23.11.2006 um 13:08 Uhr:
ja das stimmt der gebe ich ihm recht......damit muss man sich einfach aus kennen!!
|
Partyboy02
39 Jahre
männlich |
von Partyboy02 am 23.11.2006 um 13:46 Uhr:
hi milly
was ich wissen will:
wieso schreibt er die Werte aus der Exceltabelle nicht in der Wordtabelle in die erste Zeile sondern fängt mitten drin an und springt dann in die erste zeile und macht weiter
kann dir gerne mal die dateien schicken
|
gelöschter
Benutzer
|
von am 23.11.2006 um 16:08 Uhr:
das muss ich mir mal ansehen so kann ich da nichts sagen!!
|
Knall_Kopp
38 Jahre
männlich |
von Knall_Kopp am 23.11.2006 um 16:58 Uhr:
ich hab in vb fachabi machen müssen,nur so sieht man ja mal garnicht was los ist. schick den kram doch mal per mail rüber,dann kann ich mal nachschaun wo der fehler ist.
|
Partyboy02
39 Jahre
männlich |
von Partyboy02 am 23.11.2006 um 22:27 Uhr:
sodala
habe es nun hinbekommen das alles so läuft wie ich es will
ABER
er schreibt immernoch das ganze in die falsche zeile
fängt in der mitte an und geht dann in die 1 Zeile
soll aber direkt in die 1 Zeile gehen
CODE:
Dim dateiauswahl
Dim xl As Object
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim ol As Object
Dim namen() As String
Dim Bereich As Object
Dim Einzel As Integer
Dim Menge As Integer
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim gesamtpreis As Integer
Private Sub UserForm_Activate()
'Datei-Öffnen Dialog zur Auswahl der Excel Datei
'Set Dialog = CreateObject("MSComDlg.CommonDialog")
'On Error Resume Next
'With Dialog
' .Filter = "Excel (*.xls)|*.xls"
' .DialogTitel = "Datei öffnen"
' .MaxFileSize = 260
' .InitDir = "C:\"
' .ShowOpen
' If Err = 0 Then
' MsgBox "Ausgewälte Datei: " & .FileName
' End If
dateiauswahl = "C:\waren.xls"
' End With
'##Combobox mit Inhalten aus Excel füllen##
Set xl = CreateObject("excel.Application")
xl.workbooks.Open ("C:\waren.xls")
ComboBox1.Clear
Set Bereich = xl.worksheets(1).[A1].CurrentRegion
For i = 2 To Bereich.Rows.Count
ComboBox1.AddItem xl.worksheets(1).Cells(i, 1).Value
Next
ComboBox1.Value = ComboBox1.List(0)
Set wdApp = CreateObject("word.Application")
End Sub
Private Sub ComboBox1_Change()
'##Lagerbestand in Textfeld eintragen##
a = ComboBox1.ListIndex + 2
TextBox1.Text = xl.worksheets(1).Cells(a, 2).Value
End Sub
Private Sub WareBuchen_Click()
'##Benötigte Ware aus Lagerbestand ausbuchen und in Worddokument eintragen (Bezeichnung, Menge, Einzelpreis und Gesamtpreis)##
gesamtpreis = xl.worksheets(1).Cells(a, 3).Value
If TextBox2.Text = "" Then
MsgBox "Bitte geben Sie eine Mengenangabe ein", vbCritical, "FEHLER"
Else:
'Prüfung ob genügend Wäre vorhanden ist. Ggf Ausgabe über noch vorhandene Menge und Artikelbeschreibung
If TextBox1.Text < 0 Or TextBox1.Text < TextBox2.Text Then
MsgBox "Nicht genügend Ware vorhanden! Nurnoch " & xl.worksheets(1).Cells(a, 2).Value & " Stück vorhanden Bitte bestellen Sie umgehend " & ComboBox1.Value & " nach", vbCritical, "FEHLER"
'Hier wurde ein Abbruch eingefügt, damit das Programm nicht weiterrechnet
Exit Sub
'Textboxen wieder auf Standardwerte setzen
TextBox1.Text = xl.worksheets(1).Cells(a, 2).Value
TextBox2.Text = ""
Else:
a = ComboBox1.ListIndex + 2
xl.worksheets(1).Cells(a, 2).Value = TextBox1.Text
TextBox1.Text = xl.worksheets(1).Cells(a, 2).Value
' Do While c = False
'If ActiveDocument.Tables(1).Cell(a, 1).Range.Text = vbCr & Chr(7) Then
' c = True
'Else
'b = b + 1
'End If
'Loop
ActiveDocument.Tables(1).Cell(a, 1).Range.Text = TextBox2.Text
ActiveDocument.Tables(1).Cell(a, 2).Range.Text = xl.worksheets(1).Cells(a, 1).Value
ActiveDocument.Tables(1).Cell(a, 3).Range.Text = xl.worksheets(1).Cells(a, 3).Value
ActiveDocument.Tables(1).Cell(a, 4).Range.Text = gesamtpreis * TextBox2.Text
TextBox2.Text = ""
End If
End If
End Sub
Private Sub Rechnungssumme_Click()
'##Rechnungsbetrag berechnen##
End Sub
Private Sub Ende_Click()
xl.workbooks(1).Save
xl.Quit
Set xl = Nothing
End
End Sub
Private Sub UserForm_Terminate()
xl.workbooks(1).Save
xl.Quit
Set xl = Nothing
End Sub
|
gelöschter
Benutzer
|
von am 24.11.2006 um 12:08 Uhr:
das weiss ich auch nicht kann es aber mal herausfinden warum es nicht geht wenn du willst!!
|
Partyboy02
39 Jahre
männlich |
von Partyboy02 am 26.11.2006 um 21:11 Uhr:
klar will ich das Milly
tu dir keinen zwang an 
|
gelöschter
Benutzer
|
von am 27.11.2006 um 14:44 Uhr:
okay ich werde mal herausfinden das das ist ok!!
|
gelöschter
Benutzer
|
von am 14.12.2006 um 12:55 Uhr:
hast du das Problem schon gefunden??
|
