Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Here's some code. Some of it I did by "recording", for the rest I winged it.
I get fowled up at the end... each time the sheet updates, the .bmps are reinserted. I was trying to find the company name & if it's there, replace it with the bmp. Then, the next time the sheet is updated, if the bmp is there, I don't want it to do anything. (This is just a small portion of a very large set of macros which perform some automation.) Up to the ElseIF portion it seems to run fine, but I don't know how to stop the code from reinserting the bmps, so I thought I could have it search for the "extra" set each time and just delete it. If anyone can help, I'd be obliged. (Does the "recorder" add extraneous information -- more than you need to know?" It just seems so cumbersome.) Here's the code... thanks again, PS Cells.Find(What:="ABC Co", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Select If ActiveCell.Value = "ABC Co" Then Selection.ClearContents ActiveSheet.Pictures.Insert("C:\Documents and Settings\PS\Desktop\ABC Co\FileTransfer\Xmtls\XmtlLogo-DoNotRelocate.bmp").Select ' ActiveSheet.Pictures.Insert("H:\misc\XmtlLogo-DoNotRelocate.bmp").Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 12# Selection.ShapeRange.Width = 78# Selection.ShapeRange.Rotation = 0# Selection.Name = "Logo" With Selection .Placement = xlFreeFloating .PrintObject = True End With Selection.ShapeRange.IncrementTop 0.75 ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate ActiveCell.Select ActiveSheet.Pictures.Insert("C:\Documents and Settings\PS\Desktop\ABC Co\FileTransfer\Xmtls\Xmtl-em-DoNoRelocate.bmp").Select ' ActiveSheet.Pictures.Insert("H:\misc\Xmtl-em-DoNoRelocate.bmp").Select Selection.Name = "EMsign" With Selection .Placement = xlFreeFloating .PrintObject = True End With Selection.ShapeRange.IncrementTop 0.75 Selection.ShapeRange.IncrementTop 0.75 Selection.ShapeRange.IncrementTop 0.75 ElseIf ActiveSheet.Shapes.Find(What:="Logo", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Then ActiveSheet.Shapes(Array("Logo", "EMsign")).Delete Sheets("TRANSMITAL").Select End If ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _ :=True End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Indirect referencing of external spreadsheets | Excel Discussion (Misc queries) | |||
Indirect referencing closed spreadsheets | Excel Discussion (Misc queries) | |||
Spreadsheets referencing Obsolete Drive Mappings | Excel Discussion (Misc queries) | |||
Extracting or Referencing named cells in multiple spreadsheets | Excel Discussion (Misc queries) | |||
Copying Spreadsheets without referencing other workbook. | Excel Worksheet Functions |