Zum Inhalt springen

Problem bei Formatierung "Währung"

Darth Sidious

Von Darth Sidious
in Basic

 Teilen

Empfohlene Beiträge

Darth Sidious

Darth Sidious

Geschrieben
Geschrieben

Hallo,

ich habe ein Makro geschrieben in Excel mit einer UserForm.

Klappt auch alles soweit.

Nur wenn Daten eingetragen werden im Währungsformat €, dann macht er das nicht.

Dies macht er erst dann, wenn ich in die Zelle gehe, und Enter drücke.

Hier mal mein Code:


Private Sub cboBeenden_Click()

End

End Sub

Private Sub cboEintragen_Click()

Dim i, x

If txtDatum = "" Then

    MsgBox "Bitte Datum eingeben!"

    Exit Sub

End If

If txtBetrag = "" Then

    MsgBox "Bitte Buchungsbetrag eingeben!"

    Exit Sub

End If

If txtErlaeuterung = "" Then

    MsgBox "Bitte die Erläuterung noch eintragen!"

    Exit Sub

End If

For i = 4 To 75

If Sheets("Gewinnermittlung").Cells(i, 2) = "" Then

   Sheets("Gewinnermittlung").Cells(i, 2) = txtDatum


    If cboBuchen = "Abbuchen" Then

            Select Case cboKategorie

                Case "Mitgliedsbeiträge"

                    Sheets("Gewinnermittlung").Cells(i, 3) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 3).Select

                    [COLOR=red]Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"[/COLOR]

                        With Selection.Font

                        .Color = -16776961

                        .TintAndShade = 0

                        End With

                Case "Papiersammlung"

                    Sheets("Gewinnermittlung").Cells(i, 4) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 4).Select

                [COLOR=red]    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"[/COLOR]

                        With Selection.Font

                        .Color = -16776961

                        .TintAndShade = 0

                        End With

                Case "Fest"

                    Sheets("Gewinnermittlung").Cells(i, 5) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 5).Select

[COLOR=red]                   Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"[/COLOR]

                        With Selection.Font

                        .Color = -16776961

                        .TintAndShade = 0

                        End With

                Case "Spenden, Zinsen"

                    Sheets("Gewinnermittlung").Cells(i, 6) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 6).Select

[COLOR=red]                   Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"[/COLOR]

                        With Selection.Font

                        .Color = -16776961

                        .TintAndShade = 0

                        End With

                Case "Geschenke, Sonstige"

                    Sheets("Gewinnermittlung").Cells(i, 7) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 7).Select

                    [COLOR=red]Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"[/COLOR]

                        With Selection.Font

                        .Color = -16776961

                        .TintAndShade = 0

                        End With

            End Select

        Else

            Select Case cboKategorie

                Case "Mitgliedsbeiträge"

                    Sheets("Gewinnermittlung").Cells(i, 3) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 3).Select

                    [COLOR=red]Selection.NumberFormat = "#,##0.00 $"[/COLOR]

                        With Selection.Font

                            .Name = "Calibri"

                            .FontStyle = "Standard"

                            .Size = 11

                            .Strikethrough = False

                            .Superscript = False

                            .Subscript = False

                            .OutlineFont = False

                            .Shadow = False

                            .Underline = xlUnderlineStyleNone

                            .TintAndShade = 0

                            .ThemeFont = xlThemeFontMinor

                        End With

                    Sheets("Gewinnermittlung").Cells(i, 3).Font.ColorIndex = 4

                Case "Papiersammlung"

                    Sheets("Gewinnermittlung").Cells(i, 4) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 4).Select

                    [COLOR=red]Selection.NumberFormat = "#,##0.00 $"[/COLOR]

                        With Selection.Font

                            .Name = "Calibri"

                            .FontStyle = "Standard"

                            .Size = 11

                            .Strikethrough = False

                            .Superscript = False

                            .Subscript = False

                            .OutlineFont = False

                            .Shadow = False

                            .Underline = xlUnderlineStyleNone

                            .TintAndShade = 0

                            .ThemeFont = xlThemeFontMinor

                        End With

                    Sheets("Gewinnermittlung").Cells(i, 4).Font.ColorIndex = 4

                Case "Fest"

                    Sheets("Gewinnermittlung").Cells(i, 5) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 5).Select

                    [COLOR=red]Selection.NumberFormat = "#,##0.00 $"[/COLOR]

                        With Selection.Font

                            .Name = "Calibri"

                            .FontStyle = "Standard"

                            .Size = 11

                            .Strikethrough = False

                            .Superscript = False

                            .Subscript = False

                            .OutlineFont = False

                            .Shadow = False

                            .Underline = xlUnderlineStyleNone

                            .TintAndShade = 0

                            .ThemeFont = xlThemeFontMinor

                        End With

                    Sheets("Gewinnermittlung").Cells(i, 5).Font.ColorIndex = 4

                Case "Spenden, Zinsen"

                    Sheets("Gewinnermittlung").Cells(i, 6) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 6).Select

                    [COLOR=red]Selection.NumberFormat = "#,##0.00 $"[/COLOR]

                        With Selection.Font

                            .Name = "Calibri"

                            .FontStyle = "Standard"

                            .Size = 11

                            .Strikethrough = False

                            .Superscript = False

                            .Subscript = False

                            .OutlineFont = False

                            .Shadow = False

                            .Underline = xlUnderlineStyleNone

                            .TintAndShade = 0

                            .ThemeFont = xlThemeFontMinor

                        End With

                    Sheets("Gewinnermittlung").Cells(i, 6).Font.ColorIndex = 4

                Case "Geschenke, Sonstige"

                    Sheets("Gewinnermittlung").Cells(i, 7) = txtBetrag

                    Sheets("Gewinnermittlung").Cells(i, 7).Select

                    [COLOR=red]Selection.NumberFormat = "#,##0.00 $"[/COLOR]

                        With Selection.Font

                            .Name = "Calibri"

                            .FontStyle = "Standard"

                            .Size = 11

                            .Strikethrough = False

                            .Superscript = False

                            .Subscript = False

                            .OutlineFont = False

                            .Shadow = False

                            .Underline = xlUnderlineStyleNone

                            .TintAndShade = 0

                            .ThemeFont = xlThemeFontMinor

                        End With

                    Sheets("Gewinnermittlung").Cells(i, 7).Font.ColorIndex = 4

            End Select

    End If

Sheets("Gewinnermittlung").Cells(i, 8) = txtErlaeuterung

x = i - 1

Sheets("Gewinnermittlung").Cells(i, 1) = i - 3

   GoTo WEITER

End If

Next i

WEITER:

MsgBox "Buchung wurde erfolgreich eingetragen!"

txtDatum = ""

txtBetrag = ""

txtErlaeuterung = ""

ActiveWorkbook.Save

End Sub

Private Sub UserForm_Initialize()

With cboBuchen

    .AddItem "Zubuchen"

    .AddItem "Abbuchen"

    .ListIndex = 0

End With

With cboKategorie

    .AddItem "Mitgliedsbeiträge"

    .AddItem "Papiersammlung"

    .AddItem "Fest"

    .AddItem "Spenden, Zinsen"

    .AddItem "Geschenke, Sonstige"

    .ListIndex = 0

End With

txtDatum = "18 März"

txtBetrag = "000,00"

End Sub

Schonmal ein Danke an die VBler.

Darth Sidious

Darth Sidious

Geschrieben
  • Autor
Geschrieben

Ok,

ich habe es nun geschafft, dass er bei allen Positiven €-Einträgen auch das Euro zeichen mit hinschreibt.

Nun macht er es jedoch nicht bei Minusbeträgen.

Die Minusbeträge sind Rot markiert und auch als Euro Formatiert (Über "Zelle Formatieren" -> "Format" -> "Währung")

Hier nochmal mein Code:

Private Sub cboEintragen_Click()

Dim i, x


If txtDatum = "" Then

    MsgBox "Bitte Datum eingeben!"

    Exit Sub

End If

If txtBetrag = "" Then

    MsgBox "Bitte Buchungsbetrag eingeben!"

    Exit Sub

End If

If txtErlaeuterung = "" Then

    MsgBox "Bitte die Erläuterung noch eintragen!"

    Exit Sub

End If


For i = 4 To 75

If Sheets("Gewinnermittlung").Cells(i, 2) = "" Then

   Sheets("Gewinnermittlung").Cells(i, 2) = txtDatum

   Betrag = txtBetrag


    If cboBuchen = "Abbuchen" Then

        Betrag = "-" & txtBetrag

            Select Case cboKategorie

                Case "Mitgliedsbeiträge"

                    Sheets("Gewinnermittlung").Cells(i, 3).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 3).Select

                    'Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

                    '    With Selection.Font

                    '    .Color = -16776961

                    '    .TintAndShade = 0

                    '    End With

                Case "Papiersammlung"

                    Sheets("Gewinnermittlung").Cells(i, 4).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 4).Select

                    'Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

                     '   With Selection.Font

                      '  .Color = -16776961

                       ' .TintAndShade = 0

                        'End With

                Case "Fest"

                    Sheets("Gewinnermittlung").Cells(i, 5).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 5).Select

                    'Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

                     '   With Selection.Font

                      '  .Color = -16776961

                       ' .TintAndShade = 0

                        'End With

                Case "Spenden, Zinsen"

                    Sheets("Gewinnermittlung").Cells(i, 6).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 6).Select

                    'Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

                     '   With Selection.Font

                      '  .Color = -16776961

                       ' .TintAndShade = 0

                        'End With

                Case "Geschenke, Sonstige"

                    Sheets("Gewinnermittlung").Cells(i, 7).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 7).Select

                    'Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

                     '   With Selection.Font

                      '  .Color = -16776961

                       ' .TintAndShade = 0

                        'End With

            End Select

        Else

            Select Case cboKategorie

                Case "Mitgliedsbeiträge"

                    Sheets("Gewinnermittlung").Cells(i, 3).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 3).Select

                    'Selection.NumberFormat = "#,##0.00 $"

                Case "Papiersammlung"

                    Sheets("Gewinnermittlung").Cells(i, 4).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 4).Select

                    'Selection.NumberFormat = "#,##0.00 $"

                Case "Fest"

                    Sheets("Gewinnermittlung").Cells(i, 5).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 5).Select

                    'Selection.NumberFormat = "#,##0.00 $"

                Case "Spenden, Zinsen"

                    Sheets("Gewinnermittlung").Cells(i, 6).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 6).Select

                    'Selection.NumberFormat = "#,##0.00 $"

                Case "Geschenke, Sonstige"

                    Sheets("Gewinnermittlung").Cells(i, 7).FormulaR1C1 = Betrag

                    'Sheets("Gewinnermittlung").Cells(i, 7).Select

                    'Selection.NumberFormat = "#,##0.00 $"

            End Select

    End If



Sheets("Gewinnermittlung").Cells(i, 8) = txtErlaeuterung

x = i - 1

Sheets("Gewinnermittlung").Cells(i, 1) = i - 3

   GoTo WEITER

End If

Next i


WEITER:


MsgBox "Buchung wurde erfolgreich eingetragen!"


txtDatum = ""

txtBetrag = ""

txtErlaeuterung = ""


ActiveWorkbook.Save


End Sub

Erstelle ein Benutzerkonto oder melde Dich an, um zu kommentieren

Du musst ein Benutzerkonto haben, um einen Kommentar verfassen zu können

Benutzerkonto erstellen

Neues Benutzerkonto für unsere Community erstellen. Es ist einfach!

Neues Benutzerkonto erstellen

Anmelden

Du hast bereits ein Benutzerkonto? Melde Dich hier an.

Jetzt anmelden
 Teilen
Zur Themenübersicht

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Links

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...