Setting an event to an autoshape in a document

A

Anne Schouten

We have many documents based on a template that has been lost. I try to
remake the macro's but do not know how they are made. Who can help me?

The documents have 6 autoshapes (from the Drawing toolbar) and text in front
of theses shapes (not in the autoshape).

The different procedures ran when the user clicked on an autoshape (or the
tekst):

· 1 click (set focus) colors the shape green

· Double click colors the shape orange

· three clicks colors the shape red

How can I achieve this again?

Thanks, Anne
 
D

Doug Robbins - Word MVP

In the documents that you do have, does the clicking still work?

If so, if you take a look in the Visual Basic Editor with one of those
documents as the active document, you should see the code there.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
 
A

Anne Schouten

No the macro's do not work any more. De documents are not linked to the
template anymore. In the macro list I luckely still can see the names of the
macro's.

Is it possible to make a Doubleclick (etc) Event in a document or shape like
you can do with WithEvents in Word.Application?
The doubleclick event of Word.Application is not suitable here as the
selection is changed after the procedure. I do not know how to change the
color of the clicked opject (instead of the object that is left).
So I think another event is used.

Anne
 
D

Doug Robbins - Word MVP

I am not sure about the double and triple clicks, but using a macro button
that runs a macro containing the following code, each time the text
displayed in the macro button field is clicked, the color of the first shape
in the document is changed:


With ActiveDocument.Shapes(1).Fill
If .ForeColor.RGB = RGB(255, 0, 0) Then 'And .BackColor.RGB = RGB(128,
0, 0) Then
.ForeColor.RGB = RGB(0, 192, 0)
.BackColor.RGB = RGB(0, 192, 0)
ElseIf .ForeColor.RGB = RGB(0, 192, 0) Then
.ForeColor.RGB = RGB(255, 102, 0)
.BackColor.RGB = RGB(255, 102, 0)
Else
.ForeColor.RGB = RGB(255, 0, 0)
.BackColor.RGB = RGB(255, 0, 0)
End If
End With

You would need to have an auto-open macro in the document containing

Options.ButtonFieldClicks = 1

so that it works with just a single click


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
 
A

Anne Schouten

Thank You Doug for your answer.
The problem is I can not introduce a button in the documents as I have to
open all the files to put it in.
I found another solution, which is not the same as the original one, but it
works. If anyone knows how to put the double en triple click event in the
document (or shape or table) I would very much like to know it.

My solution is:
When the user clicks in de cell inwhich a shape is,(the event is: changing
the selection), the macro runs, changing the color of the shape, the macro
moves the selection to a bookmark a row above the shapes, so the user can
click once more in the cell and the color can be changed to a different
color, etc.
To react on the selection change (clicking) of the cell with the shape I had
to introduce with a WithEvents a Word.Application object(OApp) and activate
it in an autoopen procedure. Then in the OApp_WindowSelectionChange Event I
typed the following code: (the 6 shapes are in the first table of each file
in row 11)


Dim lngColor As Long



Private Sub OApp_WindowSelectionChange(ByVal Sel As Selection)

Dim n As Byte

If Sel.Information(wdWithInTable) = True And _

(UCase(ActiveDocument.AttachedTemplate) = "TEMPLATE.DOTM" Or _

ActiveDocument.AttachedTgemplate = "TEMPLATE.DOT") Then

If Sel.Information(wdEndOfRangeRowNumber) <> 11 Then Exit Sub

For n = 1 To 6

If Sel.Information(wdEndOfRangeColumnNumber) = n Then

With ActiveDocument.Shapes(n)

lngColor = .Fill.ForeColor

Call ChangeColor

.Fill.ForeColor = lngColor

On Error Resume Next

Selection.GoTo wdGoToBookmark, , , "bmkSelWeg"
'remove the selection so you can click again

If Err.Number <> 0 Then

Err.Clear

ActiveDocument.Bookmarks.Add "bmkSelWeg", _
ActiveDocument.Tables(1).Cell(10, 1) '1 row higher

Selection.GoTo wdGoToBookmark, , , "bmkSelWeg"

End If

Exit Sub

End With

End If

Next n

End If



End Sub

Sub ChangeColor()

Select Case lngColor

Case 36095 'orange

lngColor = 255

Case 255 'red

lngColor = 49152

Case 49152 'green

lngColor = 36095

Case Else

lngColor = 49152

End Select

End Sub


Anne Schouten
 

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

Top