Seite 2 von 3 ErsteErste 1 2 3 LetzteLetzte
Ergebnis 11 bis 20 von 23

Thema: VBA Autoform einfärben (Office 2013)

  1. #11
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Das ist die neue Datei. Sorry
    Angehängte Dateien Angehängte Dateien

  2. #12
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.676
    Hi,

    das ist doch dieselbe Datei nur als xlsx-Version. und es gibt nur einen Bereich in den etwas eignetragen wird und nicht mehrere.

    Außerdem sollte man schon eine xlsm-Datei mit dem entsprechenden bereits vorhandenen Code hochladen, wenn man ein VBA-Problem erörtert.

    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  3. #13
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Hallo,

    du hast Recht. Das war nicht verständlich.

    Jetzt noch einmal eine vernünftige Datei, aus dessen Code hoffentlich mein Problem hervorgeht.
    Ich will einen Code erstellen, der einmal für Affe-Löwe die Bedingung prüft, dann für A-D die Bedingung prüft und für 1-5 die Bedingung prüft.


    Liebe Grüße
    stseca
    Angehängte Dateien Angehängte Dateien

  4. #14
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.676
    So sollte der Code richtig sein:

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Columns(2)) Is Nothing Then
            If Worksheets("Tabelle4").Range("C11").Value > 79 Then
                Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(0, 179, 0)
            ElseIf Worksheets("Tabelle4").Range("C11").Value > 30 And Worksheets("Tabelle4").Range("C11").Value < 80 Then
                Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(238, 0, 0)
            ElseIf Worksheets("Tabelle4").Range("C11").Value < 31 Then
                Worksheets("Tabelle8").Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(255, 140, 0)
            End If
            If Worksheets("Tabelle4").Range("D11").Value > 79 Then
                Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(0, 179, 0)
            ElseIf Worksheets("Tabelle4").Range("D11").Value > 30 And Worksheets("Tabelle4").Range("D11").Value < 80 Then
                Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(238, 0, 0)
            ElseIf Worksheets("Tabelle4").Range("D11").Value < 31 Then
                Worksheets("Tabelle8").Shapes("Rechteck 2").Fill.ForeColor.RGB = RGB(255, 140, 0)
            End If
            If Worksheets("Tabelle4").Range("E11").Value > 79 Then
                Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(0, 179, 0)
            ElseIf Worksheets("Tabelle4").Range("E11").Value > 30 And Worksheets("Tabelle4").Range("E11").Value < 80 Then
                Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(238, 0, 0)
            ElseIf Worksheets("Tabelle4").Range("E11").Value < 31 Then
                Worksheets("Tabelle8").Shapes("Rechteck 3").Fill.ForeColor.RGB = RGB(255, 140, 0)
            End If
        End If
    End Sub
    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  5. #15
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Es hat geklappt! Danke! Tausend Dank Karin)

    Grüße
    stseca

  6. #16
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Hallo Karin,

    ich bin es nocheinmal. Es klappt soweit alles wunderbar. Nachdem ich nun noch viele weitere Autoformen hinzugefügt habe, kommt die Fehlermeldung, dass die Prozedur zu groß ist. Jetzt habe ich versucht, meinen Code in zwei Prozeduren zu unterteilen, aber leider erfolglos.
    Kannst du mir sagen, wie ich den Code anpassen muss.

    Beste Grüße
    stseca

  7. #17
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.676
    Hi,

    das kann ich so nicht nachvollziehen, dazu musst du schon mal die Mappe hochladen.

    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  8. #18
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Hallo,

    die Datei ist leider zu groß zum Hochladen. Ich habe jetzt nur meinen Code in eine Datei eingefügt. Hoffe, dass das hilft.
    Oder kann ich dir die Datei anders zukommen lassen?

    Liebe Grüße
    stseca
    Angehängte Dateien Angehängte Dateien

  9. #19
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.676
    Hi,

    lade eine Kopie deiner Mappe mit nur einigen Tabellenblättern hoch. Wahrscheinlich muss das in einer Schleife gelöst werden oder komplett anders.

    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  10. #20
    Office-Hilfe.com - Neuling
    Registriert seit
    09.08.2018
    Beiträge
    13
    Hallo,

    ich habe mal einen Link über file upload erstellt. Da ist die ganze Datei zu finden. War mir nicht sicher, ob du darüber gehen möchtest.

    https://www.file-upload.net/download...ppe1.xlsm.html

    Lieben Gruß
    stseca

Stichworte

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • Anhänge hochladen: Nein
  • Beiträge bearbeiten: Nein
  •  
Excel Ticker - News, Tipps und Tricks zu Microsoft Excel | SMS kostenlos versenden | Forenuser - Die Foren Findmaschine