| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Flickering
I know someone addressed this before, but I can't find it.
I'm inserting pictures based on cell contents. The code works great but produces a lot of flickering. here is the code: Dim wks As Worksheet For Each wks In ActiveWorkbook.Worksheets With wks Select Case LCase(.Name) Case Is = "cover" 'do nothing Case Else .Select .Range("A2:D18").Select If .Range("B25") < "" Then .Unprotect sName = .Range("A46").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("E2:H2").Select If .Range("E25") < "" Then .Unprotect sName = .Range("A47").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("I2:L18").Select If .Range("H25") < "" Then .Unprotect sName = .Range("A48").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If End Select End With Next wks Can some help Thanks, -- CY |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Flickering
Because you are inserting the full size picture then resizing, flicker will
occur. Adding a Application.ScreenUpdating=False/True around your code may help. Alternatively you can use this, which resizes prior to the insert: With Range("D5") ActiveSheet.Shapes.AddPicture .Range("A46").Text, False, True, .Left, ..Top, .Width, .Height End With Adjust the dimensions to suit. Check the for the meaning of the True & False arguments. Also, you only to .Unprotect at the beginning and .Protect at the end, not each time. NickHK "cyrus" wrote in message ... I know someone addressed this before, but I can't find it. I'm inserting pictures based on cell contents. The code works great but produces a lot of flickering. here is the code: Dim wks As Worksheet For Each wks In ActiveWorkbook.Worksheets With wks Select Case LCase(.Name) Case Is = "cover" 'do nothing Case Else .Select .Range("A2:D18").Select If .Range("B25") < "" Then .Unprotect sName = .Range("A46").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("E2:H2").Select If .Range("E25") < "" Then .Unprotect sName = .Range("A47").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("I2:L18").Select If .Range("H25") < "" Then .Unprotect sName = .Range("A48").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If End Select End With Next wks Can some help Thanks, -- CY |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Flickering
Have you put application.ScreenUpdating = False at the top and
Application.ScreenUpdating = True at the bottom. That said, if you change the appearance of the screen by putting in a picture, the screen is going to change. -- Regards, Tom Ogilvy "cyrus" wrote in message ... I know someone addressed this before, but I can't find it. I'm inserting pictures based on cell contents. The code works great but produces a lot of flickering. here is the code: Dim wks As Worksheet For Each wks In ActiveWorkbook.Worksheets With wks Select Case LCase(.Name) Case Is = "cover" 'do nothing Case Else .Select .Range("A2:D18").Select If .Range("B25") < "" Then .Unprotect sName = .Range("A46").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("E2:H2").Select If .Range("E25") < "" Then .Unprotect sName = .Range("A47").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("I2:L18").Select If .Range("H25") < "" Then .Unprotect sName = .Range("A48").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If End Select End With Next wks Can some help Thanks, -- CY |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Flickering
Nick and Tom,
Just wanted to let you guys know that your suggestions made it run 10 times better. I also moved my range selection after the IF statement. No need to select anything if the conditions are not going to be met. Thanks, -- CY "Tom Ogilvy" wrote: Have you put application.ScreenUpdating = False at the top and Application.ScreenUpdating = True at the bottom. That said, if you change the appearance of the screen by putting in a picture, the screen is going to change. -- Regards, Tom Ogilvy "cyrus" wrote in message ... I know someone addressed this before, but I can't find it. I'm inserting pictures based on cell contents. The code works great but produces a lot of flickering. here is the code: Dim wks As Worksheet For Each wks In ActiveWorkbook.Worksheets With wks Select Case LCase(.Name) Case Is = "cover" 'do nothing Case Else .Select .Range("A2:D18").Select If .Range("B25") < "" Then .Unprotect sName = .Range("A46").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("E2:H2").Select If .Range("E25") < "" Then .Unprotect sName = .Range("A47").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If Range("I2:L18").Select If .Range("H25") < "" Then .Unprotect sName = .Range("A48").Text .Pictures.Insert(sName).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 216# Selection.ShapeRange.Width = 288# Selection.ShapeRange.Rotation = 0# .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True Else End If End Select End With Next wks Can some help Thanks, -- CY |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| FLICKERING SCREEN WHEN WORKING | Excel Discussion (Misc queries) | |||
| Embedded Object Flickering | Excel Discussion (Misc queries) | |||
| FLICKERING...(fore ground font color with flickering).. | Excel Discussion (Misc queries) | |||
| Eliminate flickering | Excel Programming | |||
| Eliminate flickering | Excel Programming | |||
Linear Mode
