Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shapes in 2010
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Shapes in 2010
Check your post from Friday (06/10/2011)
"Darrell L." wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Shapes in 2010 | Excel Programming | |||
OnAction bei vielen Shapes ... ich meine sehr viele Shapes? | Excel Programming | |||
Form 4 Range of time from 1/20/2010 4:00 AM To 1/21/2010 10:00 AM | Excel Worksheet Functions | |||
When drawing shapes in excel the shapes keep disappearing | Excel Discussion (Misc queries) |