How do I search for a .bmp in a worksheet using VBA in Excel

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Let me preface by saying I am new to VBA. I have a macro which searches for
a block of text, if it is present, it is removed and replaced by an image.

If the image is present, I don't want anything to change. I do not know how
to reference the .bmp file/"named" image, and I don't want the image
re-inserted by the macro.

Can anyone help? Provide suggestions or alternate places for me to look for
help?

I'd appreciate any guidance. Thanks.
 
The .bmp must exist in a container such as a shape or a drawingobject
you will need to cylce through these to see if the fill is a picture.
But I am not sure if the actual file name and type is kept for all
containers

hope this helps
 
Thanks, but I must be doing something else wrong, because the code just isn't
working. I'll keep looking; I appreciate your help!

PS
 
Hey, tony h, sorry for the delay in getting back...

Here's the code. Some of it I did by "recording", 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 kow 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 you can help any further, 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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top