✔ Excel Tabelle in Word mit Berechnung

T

The AnonStar

Grünschnabel
Hi,

schreibe gerade ein VBA Makro in Word für automatisch generierte Vorlagen mit User-Input für regelmäßige Geschäftsvorfälle.
Aber bei der Rechnung, die ich gerade integrieren will, hakts.

Mein Ansatz ist folgender:

Visual Basic: 
Sub rechnung() 
' 
' rechnung Makro 
' 
' 
    Selection.InlineShapes.AddOLEObject ClassType:="Excel.Sheet.12", _ 
        LinkToFile:=False, DisplayAsIcon:=False 
    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify 
    Application.Run "RechnungTab" 
End Sub 

Sub RechnungTab() 
' 
' RechnungTab Makro 
' 
    Dim produkt$, produkt2$, menge$, menge2$, epreis$, epreis2$ 
    produkt = InputBox("1 = im Brief; 2 = Auf Konto", "Art der Gutschrift", "1 = im Brief; 2 = Auf Konto") 
    menge = InputBox("Gutgeschriebener Betrag in Euro", "Gutschrift", "50,00") 
    epreis = InputBox("1 = im Brief; 2 = Auf Konto", "Art der Gutschrift", "1 = im Brief; 2 = Auf Konto") 
    produkt2 = InputBox("Gutgeschriebener Betrag in Euro", "Gutschrift", "50,00") 
    menge2 = InputBox("1 = im Brief; 2 = Auf Konto", "Art der Gutschrift", "1 = im Brief; 2 = Auf Konto") 
    epreis2 = InputBox("Gutgeschriebener Betrag in Euro", "Gutschrift", "50,00") 
    ActiveCell.FormulaR1C1 = "Produkt / Leistung" 
    Range("B1").Select 
    ActiveCell.FormulaR1C1 = "Menge" 
    Range("C1").Select 
    ActiveCell.FormulaR1C1 = "Einzelpreis" 
    Range("D1").Select 
    ActiveCell.FormulaR1C1 = "Gesamtpreis" 
    Columns("A:A").Select 
    Selection.ColumnWidth = 32.29 
    Range("A2").Select 
    ActiveCell.FormulaR1C1 = produkt 
    Range("B2").Select 
    ActiveCell.FormulaR1C1 = menge 
    Range("C2").Select 
    ActiveCell.FormulaR1C1 = epreis 
    Range("C2:D15").Select 
    ActiveWindow.SmallScroll Down:=-15 
    Selection.Style = "Currency" 
    Range("D2").Select 
    ActiveCell.FormulaR1C1 = "=PRODUCT(RC[-2],RC[-1])" 
    Range("D2").Select 
    Selection.Copy 
    Range("D3").Select 
    ActiveSheet.Paste 
    Range("A3").Select 
    Application.CutCopyMode = False 
    ActiveCell.FormulaR1C1 = produkt2 
    Range("B3").Select 
    ActiveCell.FormulaR1C1 = menge2 
    Range("C3").Select 
    ActiveCell.FormulaR1C1 = epreis2 
    'Range("D3").Select 
    'Selection.Copy 
    'Range("D4").Select 
    'ActiveSheet.Paste 
    'Range("A4").Select 
    'Application.CutCopyMode = False 
    'ActiveCell.FormulaR1C1 = "TestProdZ3" 
    'Range("B4").Select 
    'ActiveCell.FormulaR1C1 = "1" 
    'Range("C4").Select 
    'ActiveCell.FormulaR1C1 = "4.95" 
    Range("A6").Select 
    ActiveCell.FormulaR1C1 = "Gesamt Betrag" 
    Range("D6").Select 
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)" 
    Range("A7").Select 
    ActiveCell.FormulaR1C1 = "Inklusive 19% Mehrwertsteuer" 
    Range("D7").Select 
    ActiveCell.FormulaR1C1 = "=PRODUCT(R[-1]C,0.19)" 
End Sub

Die Fehlermeldung erscheint aber:

Code: 
 Fehler beim kompilieren: 

Sub oder Function nicht definiert

und er mahnt den Begriff "Range" an ( Range("B1").Select )
Die oben gesetzten Inputboxen sind natürlich gerade nur als Beispiel und Test gedacht und natürlich NCIHT richtig ebschriftet.

Er soll die Tabelle aber eben richtig ausrichten:

große Spalte links für Produkteingabe, Mengenspalte, Einzelpreisspalte und Gesamtpreis.
Diese soll er dann am Ende der For-Schleife automatisch zusammenrechnen und einen Gesamtbetrag sowie die Mehrwertsteuer (imme r19%) ausweisen.

Danach kommt wieder Text.

Aber ich weiß nciht, wie ichs hinkrieg, weil er Range anmahnt..

Danke für Hilfe! =)

MfG,

Anon
 
Zuletzt bearbeitet:
Jetzt nur so als Quickie, probier mal
Visual Basic: 
ActiveSheet.Range("B1").Select
bzw. für das ganze als With-Block
Visual Basic: 
With ActiveSheet
 .Range("B1").Select
 'noch weitere
End With
Testen kann ich es nicht, hab kein MS-Office hier.


Der Doc!
 
Die Fehlermeldung ist schonmal weg, die Tabelle wird erstellt, die Variablen abgefragt..

Nachdem ich alle eingegeben habm kommt aber nun der Fehler:

Code: 
Laufzeitfehler: '424'
Objekt erforderlich

Und da meckert er in Zeile 9: "ActiveCell.FormulaR1C1 = "Produkt / Leistung""

MfG,

Anon
 
Soo.. Habs nun endlich hingekriegt =)

Der Code ist jetzt fertig und vollständig:

Visual Basic: 
Sub rechnung()
'
' rechnung Makro
'
Dim kundennummer$, zahlungstermin$, rechnungsnummer
kundennummer = InputBox("Kundennummer", "Kundennummereingabe", "k001")
rechnungsnummer = InputBox("Rechnungsnummer", "Eingabe der Rechnungsnummer", "10185")
zahlungstermin = InputBox("Zahlungstermin", "Eingabe des Zahlungstermins", "12.12.2009")
    Selection.TypeText Text:="hiermit erhalten Sie von uns Ihre bestellten Produkte und die Rechnung."
    Selection.TypeParagraph
    Selection.TypeText Text:="Bitte bewahren Sie diese Rechnung sorgfältig auf, da Sie sonst keine etwaigen Garantieansprüche geltend machen können."
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Sie sind derzeit unter der Kundennummer " + kundennummer + " bei uns Kunde. Die Rechnungsnummer lautet: " + rechnungsnummer
    Selection.TypeParagraph
    Selection.TypeText Text:="Unsere Kontodaten können Sie den beiliegenden Zetteln entnehmen. Sollten Sie bereits gezahlt haben, können Sie diesen Hinweis ignorieren."
    Selection.TypeParagraph
    Selection.TypeText Text:="Ihr spätester Zahlungstermin ist der " + zahlungstermin + ". Bitte tätigen Sie die Überweisung spätestens ein paar Tage vor diesem Termin, "
    Selection.TypeText Text:="damit wir den Betrag rechtzeitig verbuchen können."
    Selection.TypeParagraph
    Selection.TypeText Text:="Sollten Sie irgendwelche Fragen haben, können Sie sich gerne via Mail oder Telefon bei uns melden. Halten Sie dafür bitte die Rechnungsnummer und Ihre Kundennummer bereit."
    Selection.TypeParagraph
    Selection.TypeParagraph
    
    Selection.InlineShapes.AddOLEObject ClassType:="Excel.Sheet.12", _
         LinkToFile:=False, DisplayAsIcon:=False 'Erstellung des Arbeitsblattes und Öffnen von Excel
    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
    Application.Run "RechnungTab" ' Sub RechnungTab aufrufen (siehe unten)
End Sub

Sub RechnungTab()
'
' RechnungTab Makro
'
    Dim xlSheet As Object, objOLE As Object ' Per OLe Einbindung des Arbeitsballtes
    Set objOLE = ActiveDocument.InlineShapes(1).OLEFormat
    objOLE.Activate
Set xlSheet = objOLE.Object.ActiveSheet
    Dim produkt$, menge, epreis, inbox, rPreis, i, Zelle
    inbox = InputBox("Anzahl der Produkte", "Produktanzahl", "2")
    rPreis = "D3:D" & (inbox + 2) 'siehe unten.. variable für Zellen
With xlSheet 'Mit Arbeitsblatt ...
    .Range("D1:D" & (inbox + 5)).NumberFormat = "$#,##0.00_);[Green]($#,##0.00)" ' Spalte mit EURO formatieren
    .Range("C1:C" & (inbox + 5)).NumberFormat = "$#,##0.00_);[Green]($#,##0.00)" ' wie oben..
    .Range("A1").FormulaR1C1 = "Produkt / Leistung" 'Beschriftungen
    .Range("B1").FormulaR1C1 = "Menge"
    .Range("C1").FormulaR1C1 = "Einzelpreis"
    .Range("D1").FormulaR1C1 = "Gesamtpreis"
    .Columns("A:A").ColumnWidth = 32.29 ' Spalte A: Größe einstellen
     For i = 1 To inbox 'Multiinput für die Produkteingabe
        produkt = InputBox("Nächstes Produkt", "Produkteingabe", "Service á 15min")
        menge = InputBox("Menge des Produkts", "Mengeneingabe", "1")
        epreis = InputBox("Einzelpreis in Euro", "Preiseingabe", "4,95")
    .Range("A" & (i + 2)).FormulaR1C1 = produkt
    .Range("B" & (i + 2)).FormulaR1C1 = menge
    .Range("C" & (i + 2)).FormulaR1C1 = epreis
     Next i
     For Each Zelle In objOLE.Object.ActiveSheet.Range("C3:C" & (inbox + 2)) 'Verbessern der TextStattZahl in Spalte C (kp warum..)
        s = Zelle.Value
        s = s * 1
        Zelle.Value = s
    Next Zelle
    .Range(rPreis).FormulaR1C1 = "=PRODUCT(RC[-2],RC[-1])" 'siehe oben: Preisberechnung (Menge x Einzelpreis je Zeile)
    .Range("A" & (inbox + 4)).FormulaR1C1 = "Gesamt Betrag"
    .Range("D" & (inbox + 4)).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
    .Range("A" & (inbox + 5)).FormulaR1C1 = "Inklusive 19% Mehrwertsteuer:"
    .Range("D" & (inbox + 5)).FormulaR1C1 = "=PRODUCT(R[-1]C,0.19)"
End With
   
End Sub

Danke nochmal,

MfG,

The AnonStar
 
Zuletzt bearbeitet:
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück