MGT Computer Solutions >>
Services >>
Custom Programming >>
BASIC >> VBA for MS-Word
This example VBA subroutine, written for Microsoft Word 2003, inserts hour and project data fields into a Word document as part of an Effort Reporting system.
Sub InsertHourBox() ' Adds a project/hour field pair on the line where the cursor is If oGlobalWordApp Is Nothing Then Set oGlobalWordApp = Word.Application End If ' don't create an hourbox in a document that hasn't had the total fields added If oGlobalWordApp.ActiveDocument.Shapes.Count = 0 Then Exit Sub Dim cText As Shape Dim pA As Range, pB As Range Dim intIx As Integer, intI9 As Integer Dim strA As String, strName As String, strCode As String Dim lngL As Long ' if necessary, load public dictionary object hGlobalProjects with project names and descriptions If hGlobalProjects Is Nothing Then Call LoadProjects End If ' current paragraph (line) is the anchor for the textbox insertion Set pA = oGlobalWordApp.ActiveDocument.Range(Selection.Start, Selection.End) lngL = pA.Start pA.Move wdParagraph, -1 Set pA = oGlobalWordApp.ActiveDocument.Range(pA.Start, lngL) ' calculate the line's date Set pB = pA.Duplicate Do lngL = pB.Start pB.Move wdParagraph, -1 Set pB = ActiveDocument.Range(pB.Start, lngL) Loop Until Left(pB.Text, 3) = ">>>" Or lngL < 2 strA = "D" & Mid(pB.Text, 5, 3) & Format(Val(Replace(Mid(pB.Text, 9, 2), ",", "")), "00") ' initialize daily control sequence number intIx = NextAvailableIntegerfortheDay(strA) ' --- add on-demand project combobox --- Set cText = oGlobalWordApp.ActiveDocument.Shapes.AddOLEControl("Forms.ComboBox.1", 410, 0, 50, 14, pA): DoEvents ' sometimes .Top is -(what one would expect) cText.Top = 0: cText.Left = 410 cText.Name = strA & "C" & intIx: DoEvents strName = cText.Name ' for quick reference later during 'highlight' event ' add the rows of the project combobox If Not hGlobalProjects.Exists("SUPPORT") Then cText.OLEFormat.Object.AddItem "SUPPORT" End If For intI9 = 0 To hGlobalProjects.Count - 1 cText.OLEFormat.Object.AddItem hGlobalProjects.Keys(intI9) Next ' add handler for change event strCode = _ "Private Sub " & cText.OLEFormat.Object.Name & "_Change()" & vbCrLf & _ " Call UpdateDay(""" & cText.Name & """)" & vbCrLf & _ "End Sub" & vbCrLf ' --- add on-demand hourbox --- Set cText = oGlobalWordApp.ActiveDocument.Shapes.AddOLEControl("Forms.TextBox.1", 458, 0, 20, 14, pA): DoEvents cText.Top = 0: cText.Left = 458 ' sometimes .Top is -(what it should be) cText.Name = strA & "H" & intIx: DoEvents ' H=Hours cText.OLEFormat.Object.Text = "0.0" ' add handler for KeyDown event strCode = strCode & "Private Sub " & _ cText.OLEFormat.Object.Name & "_KeyDown(ByVal KeyCode As ReturnInteger, ByVal Shift As Integer)" & vbCrLf & _ " If KeyCode = 13 Then Call UpdateDay(""" & cText.Name & """)" & vbCrLf & _ "End Sub" & vbCrLf ' load event handler code DoEvents oGlobalWordApp.ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString strCode DoEvents ' highlight new project combobox oGlobalWordApp.ActiveDocument.Shapes(strName).Select End Sub