Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: sConnyle am März 07, 2016, 08:59:44 Vormittag
-
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 (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
-
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
-
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?
-
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...
=A1="Datum"
A1 ist die erste die markiert wurde.
Gruß,
steve1da
-
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:
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