0

5枚のワークブックがあります。各シートには印刷領域が定義されており、印刷領域の右上隅にワード アートを挿入したいと考えています。以下のコードを使用しています。問題は、印刷領域の右上隅ではなく、シートのどこにでも形状が表示されることです。なにか提案を ？

Sub test()

    Dim col As String, row As Long, rng As Range
    Dim sht As Worksheet, str_val As String
  Dim shp As Shape
    For Each sht In ThisWorkbook.Sheets
       str_val = sht.Name & vbNewLine & "YM" & vbNewLine & Date
       sht.Activate

       If ActiveSheet.PageSetup.PrintArea <> vbNullString Then
         col = Split(ActiveSheet.PageSetup.PrintArea, "$")(3)
         row = Range(ActiveSheet.PageSetup.PrintArea).Cells(1).row
         str_val = sht.Name & vbNewLine & "YM" & vbNewLine & Date
         Set rng = Cells(row, col)
         Set shp = ActiveSheet.Shapes.AddTextEffect(msoTextEffect28, str_val, "+mn-lt", 20, msoTrue, msoFalse, rng.Left, rng.Top)

       End If
    Next

End Sub

調べてくれてありがとう。

4

1 に答える 1

2

これは私のために働いた：

Sub Tester()

Dim shp As Shape, rngTR As Range, pa As Range
Dim t, l

    Set pa = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
    Set rngTR = pa.Rows(1).Cells(pa.Columns.Count)

    Set shp = ActiveSheet.Shapes.AddTextEffect(msoTextEffect28, _
                     "Hello World", "+mn-lt", 20, msoTrue, _
                     msoFalse, rngTR.Left, rngTR.Top)

     'adjust for shape width
    shp.Left = shp.Left - (shp.Width - rngTR.Width)

End Sub
于 2013-07-11T16:17:19.483 に答える