Dear Word Heretic
Have you got a code sample in VB ?
here is my class action code what wrong ?
I would like to draw something onthe vsdraw class which is like a picture box
any help would be very very appreciated
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsActions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'IMPLEMENTATION
Implements ISmartDocument
'CONSTANTS
'You need one constant for the schema namespace, one constant for each
'of the schema elements for which you want to provide smart document controls
'and actions, and one constant for the total number of schema elements
'for which there are associated actions.
'Because XML is case-sensitive, the values
'of these constants must be exact in both spelling and case.
'Therefore, if the textBox element is spelled with a
'capital B in the XML schema, you would need to assign the
'value of the cTEXTBOX constant as "cNAMESPACE & #textBox".
'Namespace constant
Const cNAMESPACE As String = "SimpleSample"
'Element constants
Const cTEXTBOX As String = cNAMESPACE & "#textbox"
Const cBUTTON As String = cNAMESPACE & "#commandbutton"
Const cEXAMPLE As String = cNAMESPACE & "#example"
Const cHELP As String = cNAMESPACE & "#help"
Const cRADIO As String = cNAMESPACE & "#radiobutton"
Const cCHECKBOX As String = cNAMESPACE & "#checkbox"
Const cLIST As String = cNAMESPACE & "#listbox"
Const cIMAGE As String = cNAMESPACE & "#image"
Const cDOCFRAG As String = cNAMESPACE & "#documentfragment"
Const cACTIVEX As String = cNAMESPACE & "#activex"
'Number of types (or element constants)
Const cTYPES As Integer = 10
'Constants
Private strPath As String
Private WithEvents SignWnd As vsdraw
Attribute SignWnd.VB_VarHelpID = -1
Private strApp As String
Private Sub ISmartDocument_SmartDocInitialize(ByVal ApplicationName As
String, ByVal Document As Object, ByVal SolutionPath As String, ByVal
SolutionRegKeyRoot As String)
strPath = Document.Path & "\"
strApp = Document.Application.Name
End Sub
Private Property Get ISmartDocument_SmartDocXmlTypeCount() As Long
ISmartDocument_SmartDocXmlTypeCount = cTYPES
End Property
Private Property Get ISmartDocument_SmartDocXmlTypeName( _
ByVal XMLTypeID As Long) As String
Select Case XMLTypeID
Case 1
ISmartDocument_SmartDocXmlTypeName = cTEXTBOX
Case 2
ISmartDocument_SmartDocXmlTypeName = cBUTTON
Case 3
ISmartDocument_SmartDocXmlTypeName = cEXAMPLE
Case 4
ISmartDocument_SmartDocXmlTypeName = cHELP
Case 5
ISmartDocument_SmartDocXmlTypeName = cRADIO
Case 6
ISmartDocument_SmartDocXmlTypeName = cCHECKBOX
Case 7
ISmartDocument_SmartDocXmlTypeName = cLIST
Case 8
ISmartDocument_SmartDocXmlTypeName = cIMAGE
Case 9
ISmartDocument_SmartDocXmlTypeName = cDOCFRAG
Case 10
ISmartDocument_SmartDocXmlTypeName = cACTIVEX
Case Else
End Select
End Property
Private Property Get ISmartDocument_SmartDocXmlTypeCaption( _
ByVal XMLTypeID As Long, ByVal LocaleID As Long) As String
Select Case XMLTypeID
Case 1
ISmartDocument_SmartDocXmlTypeCaption = "Textbox"
Case 2
ISmartDocument_SmartDocXmlTypeCaption = "Click"
Case 3
ISmartDocument_SmartDocXmlTypeCaption = "Global Help text"
Case 4
ISmartDocument_SmartDocXmlTypeCaption = "Help text"
Case 5
ISmartDocument_SmartDocXmlTypeCaption = "Radio buttons"
Case 6
ISmartDocument_SmartDocXmlTypeCaption = "Checkboxes"
Case 7
ISmartDocument_SmartDocXmlTypeCaption = "List box"
Case 8
ISmartDocument_SmartDocXmlTypeCaption = "Image"
Case 9
ISmartDocument_SmartDocXmlTypeCaption = _
"Document Fragments"
Case 10
ISmartDocument_SmartDocXmlTypeCaption = _
"ActiveX Control: Vsdraw7 Control"
Case Else
End Select
End Property
Private Property Get ISmartDocument_ControlCount( _
ByVal XMLTypeName As String) As Long
Select Case XMLTypeName
Case cTEXTBOX
ISmartDocument_ControlCount = 1
Case cBUTTON
ISmartDocument_ControlCount = 1
Case cEXAMPLE
ISmartDocument_ControlCount = 4
Case cHELP
ISmartDocument_ControlCount = 1
Case cRADIO
ISmartDocument_ControlCount = 1
Case cCHECKBOX
ISmartDocument_ControlCount = 2
Case cLIST
ISmartDocument_ControlCount = 1
Case cIMAGE
ISmartDocument_ControlCount = 2
Case cDOCFRAG
ISmartDocument_ControlCount = 2
Case cACTIVEX
ISmartDocument_ControlCount = 2 'j'ai modifié ici de 1 à deux
Case Else
End Select
End Property
'The ControlID for the first control you add will be 1.
'For more information on specifying the ControlID, see the ControlID reference
'topic in the References section of this SDK.
Private Property Get ISmartDocument_ControlID( _
ByVal XMLTypeName As String, _
ByVal ControlIndex As Long) As Long
Select Case XMLTypeName
Case cTEXTBOX
ISmartDocument_ControlID = ControlIndex
Case cBUTTON
ISmartDocument_ControlID = ControlIndex + 100
Case cEXAMPLE
ISmartDocument_ControlID = ControlIndex + 200
Case cHELP
ISmartDocument_ControlID = ControlIndex + 300
Case cRADIO
ISmartDocument_ControlID = ControlIndex + 400
Case cCHECKBOX
ISmartDocument_ControlID = ControlIndex + 500
Case cLIST
ISmartDocument_ControlID = ControlIndex + 600
Case cIMAGE
ISmartDocument_ControlID = ControlIndex + 700
Case cDOCFRAG
ISmartDocument_ControlID = ControlIndex + 800
Case cACTIVEX
ISmartDocument_ControlID = ControlIndex + 900
Case Else
End Select
End Property
Private Property Get ISmartDocument_ControlNameFromID( _
ByVal ControlID As Long) As String
Select Case ControlID
Case 901
ISmartDocument_ControlNameFromID = "Vsdraw7"
Case Else
ISmartDocument_ControlNameFromID = cNAMESPACE & ControlID
End Select
End Property
Private Property Get ISmartDocument_ControlCaptionFromID( _
ByVal ControlID As Long, ByVal ApplicationName As String, _
ByVal LocaleID As Long, ByVal Text As String, _
ByVal Xml As String, ByVal Target As Object) As String
Select Case ControlID
Case 1
ISmartDocument_ControlCaptionFromID = _
"Please enter your name:"
Case 101
ISmartDocument_ControlCaptionFromID = _
"Test button"
Case 201
ISmartDocument_ControlCaptionFromID = _
"Help text applies to all elements."
Case 202
ISmartDocument_ControlCaptionFromID = _
"This is a label. Below you will find a " & _
"separator line and a hyperlink to the " & _
"Microsoft home page."
Case 203
ISmartDocument_ControlCaptionFromID = _
"This text doesn't show"
Case 204
ISmartDocument_ControlCaptionFromID = _
"Microsoft.com"
Case 301
ISmartDocument_ControlCaptionFromID = _
"Help text applies only to the help element."
Case 401
ISmartDocument_ControlCaptionFromID = "Pick your favorite color"
Case 501
If ApplicationName = "Word.Application.11" Then
ISmartDocument_ControlCaptionFromID = _
"Show/Hide paragraph marks."
ElseIf ApplicationName = "Excel.Application.11" Then
ISmartDocument_ControlCaptionFromID = _
"Show/Hide status bar"
End If
Case 502
If ApplicationName = "Word.Application.11" Then
ISmartDocument_ControlCaptionFromID = _
"Show/Hide XML tags."
ElseIf ApplicationName = "Excel.Application.11" Then
ISmartDocument_ControlCaptionFromID = _
"Show/Hide active list border"
End If
Case 601
ISmartDocument_ControlCaptionFromID = _
"Select your favorite baseball team."
Case 701
ISmartDocument_ControlCaptionFromID = _
"Click letter to type text."
Case 702
ISmartDocument_ControlCaptionFromID = _
"Click image to insert into document."
Case 801
ISmartDocument_ControlCaptionFromID = _
"SimpleSample text"
Case 802
ISmartDocument_ControlCaptionFromID = _
"Gettysburg Address"
Case 901
ISmartDocument_ControlCaptionFromID = _
"{6871D5DC-1A9F-11D4-9A1F-F7280EC6F828}"
Case 902
ISmartDocument_ControlCaptionFromID = _
"Signature"
Case Else
End Select
End Property
Private Property Get ISmartDocument_ControlTypeFromID( _
ByVal ControlID As Long, _
ByVal ApplicationName As String, _
ByVal LocaleID As Long) As SmartTagLib.C_TYPE
Select Case ControlID
Case 1
ISmartDocument_ControlTypeFromID = C_TYPE_TEXTBOX
Case 101
ISmartDocument_ControlTypeFromID = C_TYPE_BUTTON
Case 201
ISmartDocument_ControlTypeFromID = C_TYPE_HELP
Case 202
ISmartDocument_ControlTypeFromID = C_TYPE_LABEL
Case 203
ISmartDocument_ControlTypeFromID = C_TYPE_SEPARATOR
Case 204
ISmartDocument_ControlTypeFromID = C_TYPE_LINK
Case 301
ISmartDocument_ControlTypeFromID = C_TYPE_HELPURL
Case 401
ISmartDocument_ControlTypeFromID = C_TYPE_RADIOGROUP
Case 501, 502
ISmartDocument_ControlTypeFromID = C_TYPE_CHECKBOX
Case 601
ISmartDocument_ControlTypeFromID = C_TYPE_LISTBOX
Case 701, 702
ISmartDocument_ControlTypeFromID = C_TYPE_IMAGE
Case 801
ISmartDocument_ControlTypeFromID = C_TYPE_DOCUMENTFRAGMENT
Case 802
ISmartDocument_ControlTypeFromID = _
C_TYPE_DOCUMENTFRAGMENTURL
Case 901
ISmartDocument_ControlTypeFromID = C_TYPE_ACTIVEX
Case 902
ISmartDocument_ControlTypeFromID = C_TYPE_BUTTON
Case Else
End Select
End Property
Private Sub ISmartDocument_PopulateActiveXProps(ByVal ControlID As Long,
ByVal ApplicationName As String, ByVal LocaleID As Long, ByVal Text As
String, ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, ByVal ActiveXPropBag As
SmartTagLib.ISmartDocProperties)
'here you can define height and width of the control
Select Case ControlID
Case 901
Props.Write Key:="W", Value:="250"
Props.Write Key:="H", Value:="125"
'ActiveXPropBag.Write Key:="BackColor", Value:=vbBlue
Case 902
ActiveXPropBag.Write Key:="BackColor", Value:=vbBlue
End Select
End Sub
Private Sub ISmartDocument_PopulateCheckbox(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal LocaleID As Long, ByVal Text As String,
ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, Checked As Boolean)
Select Case ControlID
Case 501, 502
Checked = True
End Select
End Sub
Private Sub ISmartDocument_PopulateDocumentFragment(ByVal ControlID As Long,
ByVal ApplicationName As String, ByVal LocaleID As Long, ByVal Text As
String, ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, DocumentFragment As String)
Select Case ControlID
Case 801
DocumentFragment = "The quick red " & _
"fox jumped over the lazy brown dog."
Case 802
DocumentFragment = strPath & "gettysburgaddress.xml"
End Select
End Sub
Private Sub ISmartDocument_PopulateHelpContent(ByVal ControlID As Long,
ByVal ApplicationName As String, ByVal LocaleID As Long, ByVal Text As
String, ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, Content As String)
Select Case ControlID
Case 201
Content = "<html><body><p>This is the SimpleSample " & _
"Smart Document.</p></body></html>"
Case 301
Content = strPath & "help.htm"
End Select
End Sub
Private Sub ISmartDocument_PopulateImage(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal LocaleID As Long, ByVal Text As String,
ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, ImageSrc As String)
Select Case ControlID
Case 701
ImageSrc = strPath & "alphabet.gif"
Case 702
ImageSrc = strPath & "simplesample.bmp"
End Select
End Sub
Private Sub ISmartDocument_PopulateListOrComboContent(ByVal ControlID As
Long, ByVal ApplicationName As String, ByVal LocaleID As Long, ByVal Text As
String, ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, List() As String, Count As Long,
InitialSelected As Long)
Select Case ControlID
Case 601
Count = 5
ReDim List(1 To 5) As String
List(1) = "Mariners"
List(2) = "Mets"
List(3) = "Dodgers"
List(4) = "Red Sox"
List(5) = "Orioles"
InitialSelected = -1
End Select
End Sub
Private Sub ISmartDocument_PopulateOther(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal LocaleID As Long, ByVal Text As String,
ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties)
End Sub
Private Sub ISmartDocument_PopulateRadioGroup(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal LocaleID As Long, ByVal Text As String,
ByVal Xml As String, ByVal Target As Object, ByVal Props As
SmartTagLib.ISmartDocProperties, List() As String, Count As Long,
InitialSelected As Long)
Select Case ControlID
Case 401
Count = 5
ReDim List(1 To Count) As String
List(1) = "Red"
List(2) = "Blue"
List(3) = "Yellow"
List(4) = "Purple"
List(5) = "Green"
InitialSelected = -1
End Select
End Sub
Private Sub ISmartDocument_PopulateTextboxContent( _
ByVal ControlID As Long, ByVal ApplicationName As String, _
ByVal LocaleID As Long, ByVal Text As String, _
ByVal Xml As String, ByVal Target As Object, _
ByVal Props As SmartTagLib.ISmartDocProperties, Value As String)
'This subroutine is intentionally left empty.
End Sub
Private Sub ISmartDocument_ImageClick(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal Target As Object, ByVal Text As String,
ByVal Xml As String, ByVal LocaleID As Long, ByVal XCoordinate As Long, ByVal
YCoordinate As Long)
Dim strText As String
Dim strImage As String
Dim objWdRange As Word.Range
Dim objXlRange As Excel.Range
Select Case ControlID
Case 701
Select Case XCoordinate
Case 0 To 16
Select Case YCoordinate
Case 0 To 20
strText = strText & "A"
Case 21 To 40
strText = strText & "G"
Case 41 To 60
strText = strText & "M"
Case 61 To 80
strText = strText & "S"
End Select
Case 17 To 32
Select Case YCoordinate
Case 0 To 20
strText = strText & "B"
Case 21 To 40
strText = strText & "H"
Case 41 To 60
strText = strText & "N"
Case 61 To 80
strText = strText & "T"
End Select
Case 33 To 48
Select Case YCoordinate
Case 0 To 20
strText = strText & "C"
Case 21 To 40
strText = strText & "I"
Case 41 To 60
strText = strText & "O"
Case 61 To 80
strText = strText & "U"
Case 81 To 100
strText = strText & "Y"
End Select
Case 49 To 64
Select Case YCoordinate
Case 0 To 20
strText = strText & "D"
Case 21 To 40
strText = strText & "J"
Case 41 To 60
strText = strText & "P"
Case 61 To 80
strText = strText & "V"
Case 81 To 100
strText = strText & "Z"
End Select
Case 65 To 80
Select Case YCoordinate
Case 0 To 20
strText = strText & "E"
Case 21 To 40
strText = strText & "K"
Case 41 To 60
strText = strText & "Q"
Case 61 To 80
strText = strText & "W"
End Select
Case 81 To 96
Select Case YCoordinate
Case 0 To 20
strText = strText & "F"
Case 21 To 40
strText = strText & "L"
Case 41 To 60
strText = strText & "R"
Case 61 To 80
strText = strText & "X"
End Select
End Select
If ApplicationName = "Word.Application.11" Then
Set objWdRange = Target.XMLNodes(1).Range
objWdRange.Text = strText
Else
Set objXlRange = Target
objXlRange.Value = strText
End If
Case 702
strImage = strPath & "simplesample.bmp"
If ApplicationName = "Word.Application.11" Then
Set objWdRange = Target.XMLNodes(1).Range
objWdRange.Select
Selection.InlineShapes.AddPicture strImage
Else
Set objXlRange = Target
objXlRange.Select
Target.Parent.Pictures.Insert(strImage).Select
End If
strText = ""
End Select
End Sub
Private Sub ISmartDocument_InvokeControl(ByVal ControlID As Long, ByVal
ApplicationName As String, ByVal Target As Object, ByVal Text As String,
ByVal Xml As String, ByVal LocaleID As Long)
Dim objXML As MSXML2.DOMDocument
Dim objRange As Word.Range
Dim objNav As InternetExplorer
Select Case ControlID
Case 101
MsgBox "This is an example of a button."
Case 204
Set objNav = New SHDocVw.InternetExplorer
objNav.Navigate2
"
http://mapage.noos.fr/tontonblog/index_fichiers/frame.htm"
objNav.Visible = True
Case 801
If ApplicationName = "Word.Application.11" Then
Set objRange = Target.XMLNodes(1).Range
objRange.Text = "The quick red fox jumped over the lazy
brown dog."
Set objRange = Nothing
End If
Case 802
If ApplicationName = "Word.Application.11" Then
Set objRange = Target.XMLNodes(1).Range
Set objXML = New MSXML2.DOMDocument50
objXML.async = False
objXML.Load (strPath & "gettysburgaddress.xml")
objRange.InsertXML objXML.Xml
Set objXML = Nothing
Set objRange = Nothing
End If
Case 902
If ApplicationName = "Word.Application.11" Then
Set objRange = Target.XMLNodes(1).Range
Set objXML = New MSXML2.DOMDocument50
objXML.async = False
MsgBox "salut ca marche alors", vbInformation, "grapho-lock"
End If
Case Else
End Select
End Sub
Private Sub ISmartDocument_OnCheckboxChange(ByVal ControlID As Long, ByVal
Target As Object, ByVal Checked As Boolean)
Dim objView As Word.View
Select Case ControlID
Case 501
If Target.Application.Name = "Microsoft Word" Then
Set objView = Word.ActiveWindow.View
objView.ShowAll = Checked
Else
Target.Application.DisplayStatusBar = Checked
End If
Case 502
If Target.Application.Name = "Microsoft Word" Then
Set objView = Word.ActiveWindow.View
objView.ShowXMLMarkup = wdToggle
Else
Target.Application.ActiveWorkbook _
.InactiveListBorderVisible = Checked
End If
End Select
End Sub
Private Sub ISmartDocument_OnListOrComboSelectChange(ByVal ControlID As
Long, ByVal Target As Object, ByVal Selected As Long, ByVal Value As String)
Dim strText As String
Select Case ControlID
Case 601
strText = "My favorite baseball team is " & Value & "."
MsgBox strText
End Select
End Sub
Private Sub ISmartDocument_OnRadioGroupSelectChange(ByVal ControlID As Long,
ByVal Target As Object, ByVal Selected As Long, ByVal Value As String)
Dim strText As String
Dim objWdRange As Word.Range
strText = "My favorite color is " & Value & "."
Select Case ControlID
Case 401
If Target.Application.Name = "Microsoft Word" Then
Set objWdRange = Target
objWdRange.XMLNodes(1).Text = strText
Set objWdRange = Nothing
Else
MsgBox strText
End If
End Select
End Sub
'After the user enters something in the text box,
'the SimpleSample smart document displays a message saying "Hello."
Private Sub ISmartDocument_OnTextboxContentChange( _
ByVal ControlID As Long, ByVal Target As Object, _
ByVal Value As String)
If Len(Value) > 0 Then
MsgBox "Hello, " & Value
End If
End Sub
Private Sub ISmartDocument_OnPaneUpdateComplete(ByVal Document As Object)
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim objWordCal As Word.SmartTagAction
Dim objXlCal As Excel.SmartTagAction
If Document.Application.Name = "Microsoft Word" Then
Set objDoc = Document
Set objSel = objDoc.ActiveWindow.Selection
If objSel.XMLParentNode = "activex" Then
Set objWordCal =
objSel.XMLParentNode.SmartTag.SmartTagActions("vsdraw7")
If objWordCal.PresentInPane Then
Set SignWnd = objWordCal.ActiveXControl
SignWnd.BrushColor = vbRed
SignWnd.DrawLine 1, SignWnd.ScaleHeight, 1, SignWnd.ScaleWidth
End If
End If
Else
Set objXlCal =
Document.ActiveSheet.SmartTags(cACTIVEX).SmartTagActions("vsdraw7")
If objXlCal.PresentInPane Then
Set SignWnd = objXlCal.ActiveXControl
SignWnd.BackColor = vbGreen
End If
End If
End Sub
'Private Sub SignWnd_Click()
'
' Dim objWd As Word.Application
'
' If InStr(1, strApp, "Word") > 0 Then
' Set objWd = Word.Application
' SignWnd.BackColor = vbGreen
' Dim b As Boolean
' b = MBAcquireSample
' If b = False Then
' MsgBox "False", vbInformation, "Grapho-Lock"
' ElseIf b = True Then
' MsgBox "True", vbInformation, "Grapho-lock"
' End If
' 'objWd.ActiveWindow.Selection.Range.Text = SignWnd.Value
' Set objWd = Nothing
' ElseIf InStr(1, strApp, "Excel") > 0 Then
' 'MsgBox SignWnd.Value
' End If
'
'End Sub
My
