-
This is a partial.
InternalContacts fills the first line of the contacts table with information passed to it.
PlcCOCntrct places the company information and contract number in formfields
CheckDueDate checks the due date against Now and turns it Yellow if it is due today or green if it is past due
[VBA]
Sub InternalContacts(strADLogon As String, strADEmail As String, strADOPhone As String, strADMPhone As String, strADTitle As String)
Dim TblNum As Long
Dim RowNum As Long
Dim ColNum As Long
TblNum = 2
RowNum = 2
ColNum = 1
ActiveDocument.Tables(TblNum).Cell(RowNum, ColNum).Range.Text = strADLogon
ColNum = ColNum + 1
ActiveDocument.Tables(TblNum).Cell(RowNum, ColNum).Range.Text = strADEmail
ColNum = ColNum + 1
ActiveDocument.Tables(TblNum).Cell(RowNum, ColNum).Range.Text = strADOPhone
ColNum = ColNum + 1
ActiveDocument.Tables(TblNum).Cell(RowNum, ColNum).Range.Text = trADMPhone
ColNum = ColNum + 1
ActiveDocument.Tables(TblNum).Cell(RowNum, ColNum).Range.Text = strADTitle
End Sub
Sub PlcCOCntrct(SQLCompanyName As String, SQLCompanyContractNum As String)
ActiveDocument.FormFields("CompanyName").Result = SQLCompanyName
ActiveDocument.FormFields("Company").Result = SQLCompanyName
ActiveDocument.FormFields("ContractNumber").Result = SQLCompanyContractNum
End Sub
Sub CheckDueDate()
Dim ERow As Long
Dim DueDate As Date
Dim RightNow As Date
Dim I As Long
ERow = ActiveDocument.Tables(4).Rows.Count
RightNow = Format(Now, "dd/mm/yyyy")
For I = 2 To ERow
DueDate = Format(Left$(ActiveDocument.Tables(4).Cell(I, 3).Range.Text, Len(ActiveDocument.Tables(4).Cell(I, 3).Range.Text) - 1), "dd/mm/yyyy")
'below is not required - it should be marked green when the date is inserted
'If ActiveDocument.Tables(4).Cell(I, 4).Range.Text <> Chr(13) & Chr(7) Then
' ActiveDocument.Tables(4).Cell(I, 1).Shading.BackgroundPatternColor = wdColorGreen
' ActiveDocument.Tables(4).Cell(I, 2).Shading.BackgroundPatternColor = wdColorGreen
' ActiveDocument.Tables(4).Cell(I, 3).Shading.BackgroundPatternColor = wdColorGreen
' ActiveDocument.Tables(4).Cell(I, 4).Shading.BackgroundPatternColor = wdColorGreen
'ElseIf DueDate = RightNow Then
If DueDate = RightNow Then
If ActiveDocument.Tables(4).Cell(I, 4).Range.Text = Chr(13) & Chr(7) Then
ActiveDocument.Tables(4).Cell(I, 1).Shading.BackgroundPatternColor = wdColorYellow
ActiveDocument.Tables(4).Cell(I, 2).Shading.BackgroundPatternColor = wdColorYellow
ActiveDocument.Tables(4).Cell(I, 3).Shading.BackgroundPatternColor = wdColorYellow
ActiveDocument.Tables(4).Cell(I, 4).Shading.BackgroundPatternColor = wdColorYellow
End If
ElseIf DueDate < RightNow Then
If ActiveDocument.Tables(4).Cell(I, 4).Range.Text = Chr(13) & Chr(7) Then
ActiveDocument.Tables(4).Cell(I, 1).Shading.BackgroundPatternColor = wdColorRed
ActiveDocument.Tables(4).Cell(I, 2).Shading.BackgroundPatternColor = wdColorRed
ActiveDocument.Tables(4).Cell(I, 3).Shading.BackgroundPatternColor = wdColorRed
ActiveDocument.Tables(4).Cell(I, 4).Shading.BackgroundPatternColor = wdColorRed
End If
End If
Next
End Sub
[/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules