Zum Inhalt springen

Empfohlene Beiträge

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.

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

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

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.

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...