Office 2010: Text als Hintergrund in einzelner Zelle

[sConnyle]

Hallo zusammen,

ich suche nach einer Möglichkeit, Text in bestimmen Zellen zu hinterlegen, die Zellen sind aber noch ganz normal verwendbar. Theoretisch wie in diesem Artikel: http://www.office-loesung.de/ftopic544869_0_0_asc.php Allerdings nicht für die komplette Spalte. Der angegebene Lösungsweg funktioniert bei mir leider nicht. Habt ihr vielleicht einen Tipp?
VBA wäre auch ok.

Vielen Dank
Conny

[steve1da]

Hola,

der Lösungsweg ist auch für einzelne Zellen, nicht nur für komplette Spalten.

Der angegebene Lösungsweg funktioniert bei mir leider nicht.

Heißt genau was?

Gruß,
steve1da

[sConnyle]

Vielleicht bin ich ja zu dumm, die Anleitung zu verstehen, aber bei mir passiert einfach nichts. Wenn ich die Schriftfarbe auf grau ändere, dann bleibt sie auch grau, wenn man etwas hineinschreibt. Es kommt also kein Wasserzeicheneffekt. Kann vielleicht jemand die Anleitung des Links verständlich nochmal aufschreiben?

[steve1da]

Hola,

die Schriftfarbe wird in der bedingten Formatierung auf grau gestellt.
Zellen markieren, die gefäbt werden sollen.

Start - Bedingte Formatierung - Neue Regel - Formel zur Ermittlung...

Code: [Auswählen]

=A1="Datum"
A1 ist die erste die markiert wurde.

Gruß,
steve1da

[sConnyle]

Ah, ich stand auf dem Schlauch, danke. Dann ist das auf dem Link leider nicht was ich suche.
Ich suche nach einer Möglichkeit, den Text tatsächlich in den Zellenhintergrund zu setzen. Die Zelle an sich ist aber "leer". Das heißt, es sollte nicht bereits "Datum" darin stehene.
Ich habe nun theoretisch einen passenden VBA-Text gefunden.

Dachte nur, dass es vielleicht eine einfachere Möglichkeit gibt. Hier für weitere Interessenten:

Code: [Auswählen]

Sub watermarkShape()
Const watermark As String = "watermark"
Dim cll As Range
Dim rng As Range
Dim ws As Worksheet
Dim shp As Shape

    Set ws = Tabelle2
    Set rng = ws.Range("A5:A5") 'Set range to fill with watermark

    Application.ScreenUpdating = False

    For Each shp In ws.Shapes
        shp.Delete
    Next shp

    For Each cll In rng

        Set shp = ws.Shapes.AddShape(msoShapeRectangle, 5, 5, 5, 5)

        With shp
            .Left = cll.Left
            .Top = cll.Top
            .Height = cll.Height
            .Width = cll.Width

            .Name = cll.address
            .TextFrame2.TextRange.Characters.Text = "watermark"
            .TextFrame2.TextRange.Font.Name = "Tahoma"
            .TextFrame2.TextRange.Font.Size = 8
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .TextFrame2.WordWrap = msoFalse
            .TextFrame.Characters.Font.ColorIndex = 0
            .TextFrame2.TextRange.Font.Fill.Transparency = 0.35

            .Line.Visible = msoFalse
'            Debug.Print "'SelectCell (""" & ws.Name & """,""" & cll.address & """)'"
            .OnAction = "'SelectCell """ & ws.Name & """,""" & cll.address & """'"

            With .Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .Transparency = 1
                .Solid
            End With

        End With


    Next cll

    Application.ScreenUpdating = True
End Sub

Sub SelectCell(ws, address)
    Worksheets(ws).Range(address).Select
End Sub