excel - セルの背景にテキストを挿入する

Question

セルの背景にテキストを挿入して、そのテキストの上に数字を入力できるようにする方法を探しています-個々のセルを除いて透かしに似ています。できればマクロを使用せずにこれを行う方法はありますか (ただし、これらのソリューションにも対応しています)。

Answer 1

Andrews の投稿と同様に、これは形状を正しくフォーマットし、セルを直接選択できる VBA バージョンです。

コードモジュール:

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 = Sheet1
    Set rng = ws.Range("A1:F10") '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 = 15
            .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

アップデート：

以下の例では、セル アドレスの透かしを奇数行に割り当て、偶数行を定数のままにしていますwatermark。これは、任意の条件に基づいて任意のセルに任意の透かしテキストを割り当てることができるという私のコメントに基づく例です。

Option Explicit

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 = Sheet1
    Set rng = ws.Range("A1:F10") '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
            If cll.Row Mod 2 = 1 Then
                .TextFrame2.TextRange.Characters.Text = cll.address
            Else
                .TextFrame2.TextRange.Characters.Text = watermark
            End If
            .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 = 15
            .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

Answer 2

• 背景にしたいセルを選択します。
• 「挿入」をクリックして、その場所に長方形のシェイプを挿入します。
• 図形を右クリックして、[図形の書式設定] を選択します。
• [塗りつぶし] に移動し、[図またはテクスチャの塗りつぶし] を選択します。
• 「ファイルから挿入」オプションに移動
• 透かしを入れたい画像を選択
• 長方形の場所に画像が表示されます
• 次に、画像をクリックして「右クリック」し、[画像の書式設定] を選択します。
• 「塗りつぶし」に移動し、必要に応じて透明度を上げて、「ウォーターマーク」または明るい背景のように見せます
• これも印刷されます。

ここから撮影