Shapes in 2010

[Darrell L.]

We have a quote sheet with a signature line and the user clicks a SIGN
SHEET button for which the code copies from a group of shapes with
user's signatures and places and aligns that shape on the signature
line. The code runs fine in 2003 & 2007, but it doesn't paste the
shape in 2010. The code runs through and doesn't crash, but it doesn't
paste the shape. Is it something I need to add to the code, a
reference checked on, or something else? See code below & any info on
this would be greatly appreciated.

Sub Sign()

Dim shp As Shape
Dim x As Integer
Dim c As Integer

Application.ScreenUpdating = False

If UCase(Application.UserName) Like "DAN*" Then c = 1
If UCase(Application.UserName) Like "ROB*" Then c = 2
If UCase(Application.UserName) Like "MELV*" Then c = 3
If UCase(Application.UserName) Like "GEO*" Then c = 4
If UCase(Application.UserName) Like "ABE*" Then c = 6
If UCase(Application.UserName) Like "ANN*" Then c = 6
If UCase(Application.UserName) Like "WAL*" Then c = 5

If UCase(Application.UserName) Like "CUR*" Then c = 6
If UCase(Application.UserName) Like "DARRE*" Then c = 6



Select Case c


Case 1
Set P = Sheets("Rates").Shapes("Object 3")
Range("Rep").Value = "Danny"


Case 2
Set P = Sheets("Rates").Shapes("Object 2")
Range("rep").Value = "Robert"

Case 3
Set P = Sheets("Rates").Shapes("Object 4")
Range("rep").Value = "Melvin"

Case 4
Set P = Sheets("Rates").Shapes("Picture 1")
Range("rep").Value = "George"

Case 5
Set P = Sheets("Rates").Shapes("Object 5")
Range("rep").Value = "Walt"

Case 6
PickName.Show 'USERFORM TO SELECT NAME

Case Else
MsgBox Application.UserName & " is not authorized to sign"
Exit Sub

End Select

'delete all objects and pictures from A and quote

Sheet1.Activate


For Each shp In ActiveSheet.Shapes
On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

Sheet2.Activate




For Each shp In ActiveSheet.Shapes
' On Error Resume Next
If shp.Name Like "*Object*" Then shp.Delete
If shp.Name Like "*Picture*" Then shp.Delete
Next

On Error GoTo 0



P.Copy
Sheet1.Select
Sheets("QUOTEA").Range("signature").Select
ActiveSheet.Paste



x = Range("signature").row

Selection.Top = Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Height = Worksheets("QUOTEA").Cells(x - 1, 31).Top -
Worksheets("QUOTEA").Cells(x + 1, 31).Top
Selection.Left = Worksheets("QUOTEA").Range("signature").Left

Sheet2.Select

Sheets("Quote").Range("Q_Rep").Select
ActiveSheet.Paste

x = Range("Q_rep").row

Selection.Top = Worksheets("Quote").Cells(x, 31).Top
Selection.Height = Worksheets("Quote").Cells(x, 31).Height
Selection.Left = Worksheets("Quote").Range("Q_Rep").Left


Cells(1, 1).Activate

Sheet1.Activate

Application.CutCopyMode = False

Cells(1, 1).Activate

Application.ScreenUpdating = True

End Sub

 

[Jim Cone]

Check your post from Friday (06/10/2011)


"Darrell L." <[email protected]>
wrote in message