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
