我有一张五张工作簿。每张纸都有一个定义的打印区域,我想在打印区域的右上角插入文字。我正在使用以下代码。 问题是形状出现在纸张的任何位置而不是打印区域的右上角。 有什么建议吗?
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
感谢您对此进行调查。
答案 0 :(得分: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