Start at top....

[xonico]

...oder so ähnlich.
Folgendes Problem stellt sich:
Wie man unter folgendem Link http://ehlig.cwsurf.de/DATEN/VB/ sehen kann, wird nicht am Anfang der Tabelle angefangen, sondern in der Mitte, also mit der Bestückung der Tabelle.
Folgendermaßen läuft es momentan ab:

Das ist die die Exceltabelle als "Datenbank"
Aus dem Worddokument führt man dann ein Makro aus.

Das Marko greift auf die Exceltabelle zu und befüllt die Tabelle in Word mit Werten aus der Exceltabelle

Das funktioniert soweit auch...

AABBEERR
er fängt in der Wordtabelle einfach in der Mitte an und geht dann in die 1 Zeile
wie mach ich es das er in der ersten Zeile anfängt?

 

[Nirraven]

1. geht der link net,
2. code wäre nicht schlecht.

Soll bei der Fehlersuche das ganze ungemein vereinfachen ^^

 

[xonico]

OK, der Link ist geändert. Hoffentlich funktioniert es diesmal.
Hier nochmal der Link: http://ehlig.cwsurf.de/DATEN/VB/

Die Sache mit dem Code, da hast du vollkommen recht:

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

Es ist noch ein weiterer Fehler aufgetreten....
Es wird nur in eine Zeile etwas reingeschrieben-->Also er schreibt nun das was in der Exceltabelle an 1 Stelle steht auch in Word an 1 Stelle usw

 

[wincnc]

Hallo, ändere mal in der Sub WareBuchen_Click folgendes:

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

' hier *********************************************

' prüfen ob 1 Zelle leer bzw. ein vbCr vorhanden ist, 
' falls ja - dann Text einfügen und die For - Next Schleife verlassen

Dim N As Integer

    For N = 2 To ActiveDocument.Tables(1).Rows.Count - 2
      If Mid(ActiveDocument.Tables(1).Cell(N, 1).Range.Text, 1, 1) = vbCr Then
        ActiveDocument.Tables(1).Cell(N, 1).Range.Text = TextBox2.Text
        ActiveDocument.Tables(1).Cell(N, 2).Range.Text = xl.worksheets(1).Cells(a, 1).Value
        ActiveDocument.Tables(1).Cell(N, 3).Range.Text = xl.worksheets(1).Cells(a, 3).Value
        ActiveDocument.Tables(1).Cell(N, 4).Range.Text = gesamtpreis * TextBox2.Text
        Exit For
      End If
    Next
    
' hier *********************************************
        
TextBox2.Text = ""
    
End If

 

[xonico]

Hi, ich werde deinen Vorschlag zwar nochmal testen, aber ich hab meinen Fehler gefunden: Hab' eine Variable oben gefüllt und unten dann halt nicht wieder geleert und weiter verwendet.

Trotzdem Danke