VBA, Generieren einer Bestellliste und Word-Export

Hallo zusammen,
ich habe auf Arbeit eine Excel Datei entworfen, die einen Katalog eines Lieferanten enthält. Aus dem Katalog soll eine Bestellliste generiert werden und die Bestellliste soll über einen Doppelklick in eine Word Datei exportiert werden.
Anbei ist eine Beispieldatei für mein Problem.
Userbild

Meine Idee war es, dass ein Mitarbeiter in den Katalog die Menge von den verschiedenen Produkten einträgt, die er benötigt. Sobald er alle Teile zusammen hat, sollen über ein Doppelklick in der Zelle "Bestellliste erstellen" alle Zeilen die einen Wert in der Spalte "Menge" haben in die Bestellliste eingefügt werden. Die Zeilenanzahl in der Tabelle Bestellliste ergibt sich aus den Zeilen aus dem Katalog die einen Wert in der Spalte "Menge" haben.
Nach dem Kopieren in Tabelle Bestellliste soll die Gesamtsumme der Bestellung unterhalb der Auflistung aus den Teilsummen berechnet werden.
Zum Schluss wäre es wünschenswert, wenn aus der Bestellliste ein Word Dokument automatisch erstellt werden könnte. Als Auslöser wäre auch hier ein Doppelklick in das Feld "In Word exportieren" geschickt.
Durch die Zelle "Katalog zurücksetzen" sollen die Werte in der Spalte "Menge" im Katalog wieder geleert werden nachdem die Bestellliste in Word exportiert wurde.
Falls es geschickter wäre die beiden Tabellen in verschiedene Arbeitsblätter zu legen, ist das kein Problem.
Über jegliche Code-Vorschläge wäre ich sehr dankbar!!
Viele Grüße
CG

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub CommandButton1_Click() 'Bestellung erzeugen Dim TB1, TB1Z1 As Integer, LR1 As Integer, SP As Integer, RNG As Range Dim TB2, TB2Z1 As Integer, LR2 As Integer Set TB1 = Sheets("Lieferant A") Set TB2 = Sheets("Bestellung A") Set RNG = TB1.Columns("B:H") TB1Z1 = 3 'erste Zeile mit Daten TB2Z1 = 3 'erste Zielzeile SP = 6 'Spalte mit Mengenangaben LR1 = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte With TB1.Cells(TB1Z1, SP).Resize(LR1 - TB1Z1 + 1, 1) 'Prüfen ob Mengen eingetragen wurden If WorksheetFunction.Sum(.Cells) > 0 Then LR2 = TB2.Cells(TB2.Rows.Count, "B").End(xlUp).Row + 1 'erste Freie Zeile Intersect(RNG, .SpecialCells(xlCellTypeConstants, 3).EntireRow).Copy _ TB2.Cells(LR2, 2) End If End With End Sub Private Sub CommandButton2_Click() 'Bestellung erzeugen Dim TB1, TB1Z1 As Integer, LR1 As Integer, RNG As Range Set TB1 = Sheets("Lieferant A") Set RNG = TB1.Columns("B:G") TB1Z1 = 3 'erste Datenzeile LR1 = TB1.Cells(TB1.Rows.Count, "B").End(xlUp).Row 'Bereich leeren Intersect(RNG, TB1.Cells(TB1Z1, 2).Resize(LR1 - TB1Z1 + 1, 1).EntireRow).ClearContents End Sub

Option Explicit Private Sub CommandButton1_Click() 'PDF erstellen Dim Pfad As String, Datei As String Pfad = "X:\Temp\test\" 'mit \ am Ende Datei = " " & Format(Date, "YYYY-MM-DD") Me.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Me.Name & Datei End Sub

Hallo
dann änder den Code im Blatt Lieferant wie folgt
Microsoft Excel Objekt Tabelle1

Option Explicit 
 
Private Sub CommandButton1_Click() 'Bestellung erzeugen 
    Dim TB1, TB1Z1 As Integer, LR1 As Integer, SP As Integer, RNG As Range 
    Dim TB2, TB2Z1 As Integer, LR2 As Integer 
     
    Set TB1 = Sheets("Lieferant A") 
    Set TB2 = Sheets("Bestellung A") 
     
    Set RNG = TB1.Columns("B:H") 'Bereich, der übertragen werden soll 
     
    TB1Z1 = 3 'erste Zeile mit Daten 
    TB2Z1 = 3 'erste Zielzeile 
     
    SP = 6 'Spalte mit Mengenangaben "F" 
     
    LR1 = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
     
    With TB1.Cells(TB1Z1, SP).Resize(LR1 - TB1Z1 + 1, 1) 
        'Prüfen ob Mengen eingetragen wurden 
        If WorksheetFunction.Sum(.Cells) > 0 Then 
             
            'Reset Zieltabelle 
            LR2 = TB2.Cells(TB2.Rows.Count, "H").End(xlUp).Row  'Letzte Zeile 
             
            TB2.Cells(TB2Z1, 1).EntireRow.ClearContents 'erste zeile leeren 
            TB2.Cells(TB2Z1 + 1, 1).Resize(LR2, 1).EntireRow.Delete xlUp 'Rest löschen 
             
            'Nur Zeilen mit Menge übertragen 
            Intersect(RNG, .SpecialCells(xlCellTypeConstants, 3).EntireRow).Copy TB2.Cells(TB2Z1, 2) 
             
            'Positionen setzen 
            LR2 = TB2.Cells(TB2.Rows.Count, "H").End(xlUp).Row  'Letzte Zeile 
            With TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1) 
                .FormulaR1C1 = "=ROW(R[-2]C)" 
                .Value = .Value 
            End With 
                         
            'Formatierung Summen Zeile 
            With TB2.Cells(LR2 + 1, 1).Resize(1, 8) 'Rahmen 
                .Borders(xlEdgeTop).Weight = xlMedium 
                .Borders(xlEdgeBottom).Weight = xlMedium 
                .Borders(xlEdgeRight).Weight = xlMedium 
                .Borders(xlEdgeLeft).Weight = xlMedium 
            End With 
     
            'Format aus Zeile 3 übertragen 
            TB2.Cells(TB2Z1, 1).EntireRow.Copy 
            TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1).EntireRow.PasteSpecial Paste:=xlPasteFormats 
            Application.CutCopyMode = False 
             
 
            'Summe ergänzen 
            With TB2.Cells(LR2 + 1, "G") 
                .Value = "Gesamtsumme:" 
                .HorizontalAlignment = xlRight 
                .Font.Size = 26 
            End With 
            With TB2.Cells(LR2 + 1, "H") 
                .FormulaR1C1 = "=SUM(R" & TB2Z1 & "C:R[-1]C)" 
                .Font.Size = 26 
            End With 
             
        Else 
            MsgBox "Keine Daten gefunden !" 
        End If 
    End With 
End Sub 
 
Private Sub CommandButton2_Click() 'Katalog leeren 
    Dim TB1, TB1Z1 As Integer, LR1 As Integer, RNG As Range 
     
    Set TB1 = Sheets("Lieferant A") 
     
    Set RNG = TB1.Range("F:F", "G:G") 'Menge und Preis/Stk 
     
    TB1Z1 = 3 'erste Datenzeile 
     
    LR1 = TB1.Cells(TB1.Rows.Count, "B").End(xlUp).Row 
     
    'Bereich leeren 
    Intersect(RNG, TB1.Cells(TB1Z1, 2).Resize(LR1 - TB1Z1 + 1, 1).EntireRow).ClearContents 
End Sub

LG UweD

Private Sub CommandButton1_Click() 'PDF erstellen Dim Pfad As String, Datei As String Pfad = "X:\Temp\test\" 'mit \ am Ende Datei = " " & Format(Date, "YYYY-MM-DD HHMMSS") Me.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Me.Name & Datei End Sub

Beliebteste Forumthreads (12 Monate)

VBA, Generieren einer Bestellliste und Word-Export

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA, Generieren einer Bestellliste und Word-Export

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread