| 返事が遅くなりすみません。
下記に、コードを記載します。
Sub sh_Copy()
ActiveSheet.Unprotect Password:="PASS"
Dim s As Shape
For Each s In ActiveSheet.Shapes
If Not Application.Intersect(s.TopLeftCell, Range("A1:N29")) Is Nothing Then
If s.AutoShapeType = msoShapeOval Then
s.Delete
End If
End If
Next
Dim s1 As Shape
For Each s1 In ActiveSheet.Shapes
If Not Application.Intersect(s1.TopLeftCell, Range("A1:N29")) Is Nothing Then
If s1.AutoShapeType = msoShapeRoundedRectangle Then
s1.Delete
End If
End If
Next
Dim sht As Object
For Each sht In ActiveWorkbook.Sheets
sht.TextBoxes.Delete
Next
Dim mySh As String
p1:
mySh = InputBox("いつの日程表を印刷しますか?" & Chr(13) & " 2017年1月 のように入力してください", "コピー先")
'Worksheets("印刷用").Range("A1:N29").Value = Worksheets(mySh).Range("A1:N29").Value
If mySh = "" Then Exit Sub
Worksheets(mySh).Range("A1:N29").Copy Worksheets("コピー先").Range("A1")
Range("L3").Clear
Range("J3").Clear
Dim s2 As Shape
For Each s2 In ActiveSheet.Shapes
If Not Application.Intersect(s2.TopLeftCell, Range("A1:N5")) Is Nothing Then
If s2.AutoShapeType = msoShapeOval Then
s2.Delete
End If
End If
Next
Dim s3 As Shape
For Each s3 In ActiveSheet.Shapes
If Not Application.Intersect(s3.TopLeftCell, Range("A1:N5")) Is Nothing Then
If s3.AutoShapeType = msoShapeRoundedRectangle Then
s3.Delete
End If
End If
Next
Worksheets("Sheet2").TextBoxes.Delete
ActiveSheet.Protect Password:="PASS"
End Sub
|