VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "DiagramConsole" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Public INILocal As New INIControl Private WithEvents appGrabber As Word.Application Attribute appGrabber.VB_VarHelpID = -1 Private WithEvents docThisWord As Word.Document Attribute docThisWord.VB_VarHelpID = -1 Public Diagrams As New Collection Private diaThis As Diagram Public iIndexCount As Integer Private strMediaPath As String Private strLastImage As String Public Event Deletion(ByVal iIndex As Integer) Public Event Insertion(ByVal strThisFile As String) Public Event Reconciliation() Private Sub appGrabber_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean) End Sub Private Sub appGrabber_DocumentChange() 'Occurs when the user _switches_ documents, not _alters_ them. End Sub Private Sub appGrabber_WindowSelectionChange(ByVal Sel As Selection) 'Occurs whenever the user consciously moves the cursor End Sub Private Sub Class_Initialize() Set appGrabber = Word.Application Set docThisWord = Word.ActiveDocument INILocal.FileName = "diagram.ini" strMediaPath = INILocal.ProfileEntryString("Media", "Path") If strMediaPath = "" Then strMediaPath = INILocal.WindowsDirectory If FileSystem.Dir(strMediaPath & "\MEDIA\") <> "" Then strMediaPath = strMediaPath & "\MEDIA\" Else strMediaPath = strMediaPath & "\" End If End If End Sub Private Sub Class_Terminate() 'For all intents and purposes, this procedure should execute ' but it absolutely won't. INILocal.ProfileEntryString("Media", "Path") = strMediaPath Set INILocal = Nothing End Sub Public Sub InsertDiagram(docWhere As Document, strThisFile As String, iWidth As Integer, iHeight As Integer, strCaption As String) Dim strThisMark As String If FileSystem.Dir(strThisFile) = "" Then Exit Sub ' If docWhere.Saved = False Then If Left$(docWhere.Name, 8) = "Document" And UCase$(Right$(docWhere.Name, 4)) <> ".DOC" And UCase$(Right$(docWhere.Name, 4)) <> ".DOT" Then docWhere.Save End If iIndexCount = iIndexCount + 1 'Note: If you click on End while in break mode, the Diagrams ' collection is lost. strThisMark = "DiagramMark" & Format$(iIndexCount, "0000") docWhere.Bookmarks.Add strThisMark, Selection ' Selection.InlineShapes.AddPicture FileName:=strFilename, _ LinkToFile:=True, SaveWithDocument:=True Set diaThis = New Diagram diaThis.Index = iIndexCount Set diaThis.DocOfOrigin = docWhere diaThis.Caption = strCaption Set diaThis.Location = docWhere.Bookmarks(strThisMark) diaThis.FileName = strThisFile Diagrams.Add diaThis Set diaThis = Nothing RaiseEvent Insertion(strThisFile) End Sub Public Sub RenderTable() Dim diaMake As Diagram ReconcileBookmarks Word.Documents.Add.Activate ActiveDocument.Tables.Add Range:=Selection.Range, _ NumRows:=Int(Diagrams.Count / 3) + 1, NumColumns:=3, _ DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed For Each diaMake In Diagrams Selection.InlineShapes.AddPicture diaMake.FileName Selection.MoveRight Unit:=wdCell Next diaMake Set diaMake = Nothing End Sub Public Sub ReconcileBookmarks() Dim diaCheck As Diagram For Each diaCheck In Diagrams If Not ActiveDocument.Bookmarks.Exists(diaCheck.Location.Name) Then Diagrams.Remove diaCheck.Index End If Next diaCheck Set diaCheck = Nothing RaiseEvent Reconciliation End Sub Public Sub SendCaption(strCaption As String) End Sub Private Sub docThisWord_Close() 'This is the procedure we have to use in place of ' Class_Terminate. INILocal.ProfileEntryString("Media", "Path") = strMediaPath Set INILocal = Nothing End Sub Public Property Get MediaPath() As String MediaPath = strMediaPath End Property Public Property Let MediaPath(strSetting As String) If FileSystem.Dir(strSetting) <> "" Then strMediaPath = strSetting INILocal.ProfileEntryString("Media", "Path") = strMediaPath End If End Property Public Property Get LastImage() As String LastImage = strLastImage End Property Public Property Let LastImage(strSetting As String) If FileSystem.Dir(strSetting) <> "" Then strLastImage = strSetting INILocal.ProfileEntryString("Media", "LastImage") = strLastImage End If End Property