View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Ken Johnson Ken Johnson is offline
external usenet poster
 
Posts: 1,073
Default Generating a drawing based on a cell Value (Repost Attempt)



On Nov 23, 7:55 am, wrote:
Tom Ogilvy wrote:
Put this code in a general module (insert=Module in the VBE) rather than the
sheet module which your descriptions indicates is its current location.


Sub Generate_Drawing()
Dim s As String, i As Integer, d as Object
s = "S:\Engineering\Drawings\Drawing Generator\Images" & _
Range("E56").Value & ".EMF"


if dir( s) = "" then exit sub
ActiveSheet.Range("C5").Select
for each d in Activesheet.DrawingObjects
if d.TopLeftCell.Address = "$C$5" then
d.Delete
end if
Next
ActiveSheet.Pictures.Insert s
End Sub
Put your button (from the forms toolbar) on the sheet and assign the macro.


--
Regards,
Tom OgilvyHi Tom,


I tried doing the above but couldn't get anything to work at all. I
deleted the code in the worksheet and added the module as specified.
However, the good news is I used part of your code and merged it into
my existing one.

Sub Generate_Drawing()
Dim s As String, i As Integer, d As Object
s = "S:\Engineering\Drawings\Drawing Generator\Images"
ActiveSheet.Range("C5").Select
For Each d In ActiveSheet.DrawingObjects
If d.TopLeftCell.Address = "$C$5" Then
d.Delete
End If
Next
With Application.FileSearch
.NewSearch
.LookIn = s
.SearchSubFolders = False
.Filename = "*" & ActiveSheet.Range("E56") & ".EMF"
.Execute
For i = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert (.FoundFiles(i))
Exit For
Next i
End With
End Sub

This code allows me to delete any existing drawing I had and replace it
with the new one, while still keeping the logo and button. Although it
works, your code seems much more clean and sleek, not knowing anything
about VB, mine looks more cluttered and may have some things in it that
aren't neccessary, any idea if it can be cleaned up?

As mentioned in a previous post, is it possible to eliminate the button
completely and run the macro based on the value of E53 changing? I
tried the method as instructed in another post, but I must have added
or left some stuff out.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$3" Then

Would seem to do the trick, but how would I integrate this into my
code?

Thanks again,
Romy


Hi Romy,

Does E56 (or is it E53?) change because it is directly edited by the
user or does it contain a formula?

If it is E56 edited by the user then you could use...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E56")) Is Nothing Then
Generate_Drawing
End If
End Sub

pasted into the worksheets code module (copy coderight click sheet
tabselect "View Code" Paste the code)

I used Tom's version of Generate_Drawing in a standard code module.

If it is E56 with a formula that recalculates to a new value then
instead of the above code you could use...

Private Sub Worksheet_Calculate()
Generate_Drawing
End Sub

If you use the SelectionChange event you would have to add code to
disable events at the start then enable events at the end to avoid the
code being repeatedly re-fired by the selection change it contains.

Ken Johnson