Office: Tägliche automatische Verschiebung eines Rechtecks

Hallo zusammen,

ich habe folgendes Anliegen und hoffe jemand kann mir dabei helfen.

Wie kann ich das rote Rechteck (siehe Anhang) automatisch am jeweiligen Tag beim erstmaligen Öffnen auf den aktuellen Tag verschieben ?

Vielen Dank schonmal für jede Hilfe !

 

Wenn ich es richtig verstanden habe, geht es darum, den jeweils aktuellen Tag farbig dazustellen.
Bedingte Formatierung verwenden. Zellbereich auswählen und mit aktuellem Datum vergleichen.
Sprich: Wenn du in einer Zelle mit =HEUTE() das heutige Datum abrufst, dann verweise einfach darauf (siehe Bild).

 

Wenn es dir reicht, nur die Zelle mit dem Datum zu umranden, dann benötigst du nur die 1. Bedingte Formatierung.
=A3=$A$1
In Zelle A1 ist das Datum. Du kannst es ja mal testen, wenn du in A1 einfach ein vorhandenes Datum einträgst.
Später kannst du dann in den Bedingten Formatierungen $A$1 mit der Funktion HEUTE() austauschen.

Soll der Rahmen dann unbedingt über 5 Zellen gehen, dann musst du auch 5 verschiedene Bedingte Formatierungen anlegen. Achte genau auf die Schreibweise. Die Bereiche müssen ebenfalls angepasst werden.

=A3=$A$1 Bereich: =$A$3:$G$15
=UND(A3=$A$1;ZEILEN(A3:A4)=2) Bereich: =$A$4:$G$16
=UND(A3=$A$1;ZEILEN(A3:A5)=3) Bereich: =$A$5:$G$17
=UND(A3=$A$1;ZEILEN(A3:A6)=4) Bereich: =$A$6:$G$18
=UND(A3=$A$1;ZEILEN(A3:A7)=5) Bereich: =$A$7:$G$19

NICHT bei allen 5 den vollständigen Rahmen aussuchen, sondern jeweils nur das passende Teilstück.
Als Anhang erhälst du dann noch eine Excel-Tabelle...wenn das mal nicht ausreicht...

 

Hi,

folgenden Code ins Codemodul DieseArbeitsmappe:

Code:

Private Sub Workbook_Open()
    Dim rngDatum As Range
    Dim shaShape As Shape
    With Worksheets("Tabelle1") '<== Tabellenname anpassen!
        Set rngDatum = .UsedRange.Find(Date, lookat:=xlWhole, LookIn:=xlFormulas)
        If Not rngDatum Is Nothing Then
            For Each shaShape In .Shapes
                If shaShape.Name = "Rectangle 1" Then '<== Name des Rechtecks anpassen!
                    shaShape.Top = rngDatum.Top - rngDatum.Height / 2
                    shaShape.Left = rngDatum.Left
                    Exit For
                End If
            Next shaShape
        End If
    End With
End Sub

Hinweis: falls sich deine Datumswerte aus Formeln berechnen, dann im Code LookIn:=xlFormulas ersetzen durch LookIn:=xlValues

---

 

Vielen Dank schonmal für die kompetente Hilfe!
@Roger977 Ist es auch möglich die Rahmen entsprechend dick einzustellen? Weil mein Zieldokument hat mehrere farbige Felder und deswegen wird man den dünnen roten Rahmen kaum sehen... Danke schonmal für die Antwort

 

Da bin ich überfragt. Bei den bedingten Formatierungen werden nicht alle Rahmenoptionen angeboten, wie es bei der "normalen" Rahmenformatierung der Fall ist. Per VBA sähe das vielleicht anders aus.

 

Moin!
Vielleicht hilft das hier weiter:

Code:

Sub Formatierung_Suchen()
Dim r As Integer, c As Integer
Dim z As Integer, s As Integer

r = ActiveSheet.UsedRange.Rows.Count
c = ActiveSheet.UsedRange.Columns.Count

For z = 1 To r
    For s = 1 To c
        If Cells(z, s).Interior.Color = 255 Then
            Cells(z, s) = "XXX"
        End If
    Next s
Next z

End Sub

Als Zell-Eigenschaft/Formatierung musst dann eben die BORDERS abfragen.

Grüße

 

Das hier ist ein gutes Beispiel: Beverly und Bastler haben vermutlich das gleiche Ziel erreicht. Ich sehe da überhaupt keinen schlüssigen Zusammenhang zwischen den beiden VBA-Codes. Ich werde VBA nie verstehen
Gibt es hier auch Tutorial für VBA?

 

"Ich werde VBA nie verstehen" Na, du gibst aber schnell auf. Wenn Du nach "VBA-Tutorial" im Netz suchst, findest Du VBA-Tutorial.de

Grüße

 

Beide Codes machen vollkommen unterschiedliche Dinge - dazu muss man VBA nicht unbedingt verstehen sondern einfach mal testen.
Da du in deinem Eröffnungsbeitrag geschrieben hattest, dass du ein rotes Rechteck täglich verschieben möchtest, habe ich meinen Code genau für diesen Zweck erstellt - hier nochmal der Code mit Kommentaren, damit du verstehst was vor sich geht:

Code:

' Code ausführen beim Öffnen der Arbeitsmappe
Private Sub Workbook_Open()
    Dim rngDatum As Range
    Dim shaShape As Shape
    ' alles bezieht sich auf Tabelle1
    With Worksheets("Tabelle1") '<== Tabellenname anpassen!
        ' suche das heutige Datum im benutzten Zellbereich der Tabelle
        Set rngDatum = .UsedRange.Find(Date, lookat:=xlWhole, LookIn:=xlFormulas)
        ' das Datum wurde gefunden
        If Not rngDatum Is Nothing Then
            ' laufe in einer Schleife über alle eingefügten Formen
            For Each shaShape In .Shapes
                ' der name der laufenden Form ist "Rechteck 1"
                If shaShape.Name = "Rectangle 1" Then '<== Name des Rechtecks anpassen!
                    ' Oberkante der gefundenen Form = Oberkante der Zelle mit dem Datum - halbe Höhe der Zelle
                    ' damit die Form etwas oberhalb der gefundenne Zelle beginnt
                    shaShape.Top = rngDatum.Top - rngDatum.Height / 2
                    ' linke Kante der Form = linke Kante der gefundenen Zelle
                    shaShape.Left = rngDatum.Left
                    ' Schleife verlassen da weitere Formen nicht gegeprüft werden müssen
                    Exit For
                End If
            Next shaShape
        End If
    End With
End Sub

---

 

Nun ja, ich werde auch nicht wirklich aufgeben. Ich habe bislang 1,2 x VBA gebraucht. Hat ewig gedauert, bis das geklappt hat. Vielen Dank für den Link. Das schaue ich mir mal an.

 

Wahrscheinlich bekomme ich jetzt wieder von irgendjemand hier Haue, weil ich hier auf ein anderes Forum verweise. Dort liegt meine persönliche Snippet-Sammlung ergänzt und optimiert von Kollegen. Derzeit einfach mal reinschauen, weil leider wegen Spam noch deaktiviert, was sich hoffentlich bald ändern lässt.
Grüße

 

Sorry, da hab ich mich mit dem Zitieren vertan, Beverly. Ich wollte es nur kürzen. Aber ich denke, man erkennt dennoch, was von dir kommt und was ich geschrieben habe.

 

Herzlichen Dank, besonders der 1. Link gefällt mir. Beim ersten betrachten denke ich, dass das zum Einstieg genau die richtige "Masse" ist. Alle Grundlagen werden angesprochen ohne zu überfrachten. Da bin ich erstmal beschäftigt.