MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 14.06.2018, 18:12   #31
Macanudo
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

die Datei ist noch geschlossen. Diese befindet sich nicht im selben Ordner.

C:Eigene DateienRechnungenRechnungsnummer.xlsx

C:Eigene DateienAllgemeinBauteile.xlsm

So ist die Ordnerstruktur.

Die 1. Abschlagrechnung ensteht, wenn ich das erste mal Bauteile aussuche und dann auf den Button Gesamtsumme drücke. Die 2. Abschlagrechnung ensteht, wenn ich weitere Bauteile aussuche und wieder auf Gesamtsumme drücke. usw.

Ich habe noch einen Code, der mir diese Rechnung als PDF in einen zu erstellenden Ordner kopiert. Am Am Ende könnte man dann einen Button aufmachen, der mich fragt, ob zurückgesetzt werden soll oder nicht. Der Code muss noch in einigen Kleinigkeiten angepasst werden ( Pfad und Zellen) aber so soll er aussehen.

Code:

Sub PDF()
Application.ScreenUpdating = False
    Dim DateiPfad As String
    Dim DateiName As String
    Dim varNamArr As Variant
    Dim intAnz As Integer
    DateiPfad = "C:UsersritteBuchhaltungRechnungen " & Format(Now, "YYYY") & "" & Format(Now, "MMMM YYYY") & ""

    If Dir(DateiPfad, vbDirectory) <> "" Then
      Else
      MkDir DateiPfad
      End If
    varNamArr = Array("Rechnung", "Rechnung")
    Sheets("Rechnung").Select
    For intAnz = 0 To 1
        If Len(Sheets(varNamArr(intAnz)).Range("A26")) > 0 Then
            DateiName = DateiPfad & Sheets(varNamArr(intAnz)).Range("F15") & " " & Sheets(varNamArr(intAnz)).Range("C6") & ".pdf"
            Sheets(varNamArr(intAnz)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                DateiName, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                False
        End If
    Next intAnz
  
 Application.ScreenUpdating = True
 
End Sub

Vielen Dank.

Viele Grüße

Uwe
Macanudo ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 06:01   #32
aloys78
MOF Meister
MOF Meister
Standard

Hallo Uwe,

Vorschlag zum 1. Teil; den entsprechenden Code durch den nachfolgenden austauschen.
In diesem Zusammenhang habe ich beim Kopieren das Format Buchhaltung an Stelle des bisherigen Formats Währung zugeordnet.
Code:

Option Explicit

' Version V3.4 vom 15.06.2018
    
    Dim Q As Worksheet              ' Quell-Tabelle
    Dim Z As Worksheet              ' Ziel-Tabelle
    Dim button As MSForms.CommandButton

    Dim LRowZ As Long               ' letzte Zeile Ziel
    Dim LRowZ2 As Long              ' Zeilen# letzte Eintragung in Sp G
    Dim r As Long                   ' Zeilen# in Ziel
    
    Const zStart As Long = 4        ' Startzeile Ziel-Tabelle
    Const ZSpalte As String = "A"   ' Eintragen der gefilterten Daten ab dieser Spalte
    Const nRows As Long = 4         ' Anzahl Leerzeilen nach der Zeile "Zwischensumme"
    Const TxT As String = "Zwischensumme:"
    Const TxTG As String = "Gesamtsumme:"
    Const F_Buchhaltung = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Const RechnungsNR As String = "C:Eigene DateienRechnungenRechnungsnummer.xlsx"
    ' Const RechnungsNR As String = "D:AlleForenMS_Office_ForumUweRechnungsnummer.xlsx"   ' nur für Test
    

Private Sub CommandButton1_Click()
'--------------------------------------------------------------------------------------------
' Endsumme bilden und ggf vorher schon vorhandene Endsumme als Zwischensumme ausweisen

' Version V3.4 vom 14.06.2018

'--------------------------------------------------------------------------------------------
    Dim sw As Boolean
    Dim Summe As Currency
    Dim wbR As Workbook                 ' Workbook RechnungsNr
    Dim wsR As Worksheet
    Dim r2 As Long                      ' Zeilen# RechnungsNR
    
    Set button = ActiveSheet.CommandButton1
    Set Q = Worksheets("Tabelle1")
    Set Z = Worksheets("Tabelle2")
    
    With Z
        
' suche einen etwa vorhandenen Text "Zwischensumme" in Sp G
        LRowZ = .Cells(Rows.Count, ZSpalte).End(xlUp).Row       ' Zeilen# letzte Artikel#
        For r = LRowZ To zStart Step -1
            If .Range("G" & r) = TxT Then       ' älteres Zwischenergebnia liegt vor
                Summe = .Range("I" & r)         ' letzte und aktuelle Zwischensumme
                r = r + nRows                   ' Startzeile der Endergebnis
                sw = True                       ' Schalter: True = älteres Zwischenergebnis liegt vor
                Exit For
            End If
        Next r
        
' Startspalte wenn bisher noch keine Zwischensumme vorlag
        If sw = False Then
            r = zStart
            Summe = 0
        End If
       
' Endsumme bilden aus letzer Zwischensumme und den vorher eingegebenen Einzelpositionen
        Summe = Summe + WorksheetFunction.Sum(.Range("I" & r & ":I" & LRowZ))
        
' Gesamtsumme ausgeben
        r = LRowZ + 2
        .Range("G" & r) = TxTG
        .Range("I" & r) = Summe                                     ' Gesamtsumme ohne Abzüge
        .Range("I" & r).NumberFormat = F_Buchhaltung
        
' Abzüge darstellen
        .Range("G" & r + 1) = IIf(Q.Range("iNachlass") = 0, "", Q.Range("iNachlass") * 100 & "% Nachlass")     ' Nachlass
        .Range("I" & r + 1) = IIf(Q.Range("iNachlass") = 0, 0, Q.Range("iNachlass") * Summe * (-1))
        .Range("I" & r + 1).NumberFormat = F_Buchhaltung
        
        .Range("G" & r + 2) = "0,3% Versicherung"                   ' Versicherung für Summe - Nachlass
        .Range("I" & r + 2) = (Summe + .Range("I" & r + 1)) * -0.003
        .Range("I" & r + 2).NumberFormat = F_Buchhaltung
        
        .Range("G" & r + 3) = "10% AZ Einbehalt"                    ' AZ Eibehalt für Summe - Nachlass                                               ' Versicherung
        .Range("I" & r + 3) = (Summe + .Range("I" & r + 1)) * -0.1
        .Range("I" & r + 3).NumberFormat = F_Buchhaltung
        
        .Range("G" & r + 4) = "bereits gezahlt"                     ' bereits gezahlt                                                ' Versicherung
        .Range("I" & r + 4) = -Q.Range("iGezahlt")
        .Range("I" & r + 4).NumberFormat = F_Buchhaltung
        
' Noch zu zahlen
        .Range("G" & r + 5) = "noch zu zahlen"                      ' noch zu zahlen                                               ' Versicherung
        .Range("I" & r + 5) = WorksheetFunction.Sum(.Range("I" & r & ":I" & r + 4))
        .Range("I" & r + 5).NumberFormat = F_Buchhaltung
        
' RechnungsNr eintragen
        Application.ScreenUpdating = False
        On Error Resume Next
        Workbooks.Open Filename:=RechnungsNR
        If Err.Number <> 0 Then
            MsgBox RechnungsNR & " nicht gefunden !", vbCritical
            On Error GoTo 0
            GoTo Ende
        End If
        On Error GoTo 0
        Set wbR = ActiveWorkbook
        ThisWorkbook.Activate
        Set wsR = wbR.Worksheets("Tabelle1")
        r2 = wsR.Cells(Rows.Count, "B").End(xlUp).Row + 1
        .Range("A2") = wsR.Range("A" & r2)              ' Rechnungs#
        wsR.Range("B" & r2) = .Range("A3")              ' Name
        .Range("I" & r + 5).Copy wsR.Range("C" & r2)    ' Noch zu zahlen
        Application.DisplayAlerts = False
        wbR.Save
        wbR.Close
        Application.DisplayAlerts = True

'Abschlussarbeiten
Ende:
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        Set button = ActiveSheet.CommandButton1
        button.Visible = False                       ' Button unsichtbar schalten
    End With
    
    MsgBox "Endsumme wurde " & IIf(sw = True, "neu ", "") & "gebildet !", vbInformation
End Sub
Beim 2. Teil Deines Beitrages sehe ich keine Beziehung zur Datei Bauteile.
Wie stellst Du Dir das Verfahren konkret vor ?

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 08:11   #33
Macanudo
Threadstarter Threadstarter
MOF User
MOF User
Standard

Guten Morgen Aloys,

der erste Teil klappt sehr gut.

Meinst du mit dem 2. Teil das mit der Abschlagsrechnung?

Folgendes stellt sich mein Chef vor:

Ich suche mir Bauteile durch Doppelklick aus und drücke, wenn ich sie habe auf Gesamtsumme.

Er zieht mir die Rechnungsnummer, und dabei soll z.B. in Tabelle2 A6 stehen: "1. Abschlagsrechnung".

Jetzt kommen wieder Bauteile hinzu durch Doppelklick, diese werden wieder durch den Button Gesamtsumme eingetragen. Dann soll aus "1. Abschlagsrechnung" die "2. Abschlagsrechnung" werden. usw.


So, nun zum Speichern als PDF.

In die Datei Bauteile baue ich folgenden Code ein. Dieser speichert mir die Tabelle2 als PDF in einen variablen Ordner. Das funktioniert auch. Das werde ich vielleicht über einen Button in Tabelle2 lösen. Nun könnte man, wenn ich den Button gedrückt habe und die Tabelle2 als PDF gespeichert wurde, einen Hinweis anzeigen lassen, ob die Abschlagsrechnungen zurückgesetzt werden sollen, oder nicht.

Ich schicke Dir noch einmal den PDF Code mit.

Code:

Sub PDF()
Application.ScreenUpdating = False
    Dim DateiPfad As String
    Dim DateiName As String
    Dim varNamArr As Variant
    Dim intAnz As Integer
    DateiPfad = "C:UsersritteBuchhaltungRechnungen " & Format(Now, "YYYY") & "" & Format(Now, "MMMM YYYY") & ""

    If Dir(DateiPfad, vbDirectory) <> "" Then
      Else
      MkDir DateiPfad
      End If
    varNamArr = Array("Tabelle2", "Tabelle2")
    Sheets("Tabelle2").Select
    For intAnz = 0 To 1
        If Len(Sheets(varNamArr(intAnz)).Range("A2")) > 0 Then
            DateiName = DateiPfad & Sheets(varNamArr(intAnz)).Range("A2") & " " & Sheets(varNamArr(intAnz)).Range("A3") & ".pdf"
            Sheets(varNamArr(intAnz)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                DateiName, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                False
        End If
    Next intAnz
  
 Application.ScreenUpdating = True
 
End Sub
Vielen Dank.

Viele Grüße

Uwe
Macanudo ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 10:32   #34
aloys78
MOF Meister
MOF Meister
Standard

Hallo Uwe,

Zitat:

Meinst du mit dem 2. Teil das mit der Abschlagsrechnung?

Nein - das Thema hattest Du bisher überhaupt noch nicht angesprochen !

Zitat:

Er zieht mir die Rechnungsnummer, und dabei soll z.B. in Tabelle2 A6 stehen: "1. Abschlagsrechnung".

1. Ist dieses Thema neu !
2. Wieso nach A6 ? Da stehen doch Daten !

Zitat:

Nun könnte man, wenn ich den Button gedrückt habe und die Tabelle2 als PDF gespeichert wurde, einen Hinweis anzeigen lassen, ob die Abschlagsrechnungen zurückgesetzt werden sollen, oder nicht.

Ja !
Das dürftest Du aber alleine hinkriegen !

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 11:01   #35
Macanudo
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

oh je, was meinst du dann mit dem 2. Teil? Da bin ich jetzt verwirrt.

Das mit der "Abschlagsrechnung" hatte ich in #29 angesprochen, ist vielleicht nicht so richtig rübergekommen. Es soll keine richtige Abschlagsrechnung sein, sondern nur eine Information in einer Zelle.

Die Zellenangabe "A6" war nur beispielhaft, da können wir auch "G1" nehmen.

Es geht mir bei der Angabe mit der Abschlagsrechnung darum, dass es hochzählt und wenn ich den Button drücke, dass es wieder auf Null gesetzt wird. Da scheitert es bei mir.

Button erstellen und den mit Leben füllen, das bekomme ich hin. Nur halt nicht, dieses hochzählen und dann auf 0 setzen.

Hoffentlich konnte ich etwas Licht ins Dunkle bringen.

Vielen Dank.

Viele Grüße

Uwe
Macanudo ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.06.2018, 11:17   #36
Macanudo
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

das mit dem Hochzählen habe ich jetzt anders gelöst. Konnte mich an eine alte Datei von mir entsinnen, da hatte ich ein ähnliches Problem. Ich habe es mit folgendem Code gelöst.

Code:

Sub zählen()
Dim x As Range
Set x = Sheets("Tabelle1").Range("G1")
x = x + 1
End Sub
Den Rest werde ich jetzt anpassen und mir einen Button schmieden.

Vielen lieben Dank für Deine unendliche Geduld.

Viele Grüße

Uwe
Macanudo ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:18 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.