Module 1 - Lesson 1 Exercises Page 1-9
| 3. | No, make the macro non-interactive and then use a combination of FilterEdit and FilterApply or use the SendKeys statement before the FilterApply method. |
| 4. | No, remove the Copies:= from the statement to make it read >> FilePrint 1. Also, changing any default settings will fix it, i.e. add the parameter Color:=True |
Module 1 - Lesson 2
"Try This: Using Declared Data" Page 1-17
1. The error "Variable Not Defined" appears - to correct the problem, change State to a public variable using Public in place of the Dim statement.
2. Local takes precedence
Module 1 - Lesson 2 Exercises Page 1-23
| 1. | A variable should be used. It will be declared in the General Declarations section using either the Private or Dim statement. The value will be set in the procedure where the condition is tested. While the value does not change, it is not possible to declare a constant without assigning it a value and once it is declared, it cannot be modified. |
Dim VariableName as Integer
Sub Sample()
VariableName = expression
End Sub
| 2. | The customer may not be using the appropriate data type for the arrays. For example, the values may be integers but the arrays are declared using the variant data type. This can significantly slow execution if very large arrays (or many variables) are involved. |
3.
Sub Sample()
MsgBox Val(InputBox("Enter number")) * 100
End Sub
4.
Sub Auto_Open()
MsgBox Now()
End Sub
Module 1 - Lesson 2 Exercises (continued)
5.
Sub StringFun()
Dim daString As String
Dim vFirstWord, vMiddleWord, vLastWord As String
Dim v3rdSpace, vSpacePos1, vSpacePos2 As Integer
daString = InputBox("Enter 5 words separated by spaces")
'Finds position of 3rd space and deletes everything to the right
v3rdSpace = InStr(InStr(InStr(1, daString, " ") + 1, _
daString, " ") + 1, daString, " ")
daString = Trim(Left(daString, v3rdSpace - 1))
'Determines positions of the two spaces between the three words
vSpacePos1 = InStr(1, daString, " ")
vSpacePos2 = InStr(vSpacePos1 + 1, daString, " ")
'Pulls out words
vFirstWord = Left(daString, vSpacePos1 - 1)
vLastWord = Right(daString, Len(daString) - vSpacePos2)
vMiddleWord = Mid(daString, vSpacePos1 + 1, _
vSpacePos2 - vSpacePos1 - 1)
'Concatenates message with linefeeds
MsgBox vFirstWord & Chr(10) & vMiddleWord & Chr(10) & vLastWord
End Sub
Module 1 - Lesson 3 Exercises Page 1-30
1.
Sub GenerateArrayValues()
Dim MyArray(1 To 2, 1 To 10) 'Array declaration
Dim Counter As Integer 'Counts the number of times a value is assigned to the array
Dim RandNum As Integer 'Stores the random number
Dim Used As Boolean 'Indicates if number has already been assigned to the array
Dim i As Integer 'Used as a loop counter in various areas of the procedure
Counter = 0
Randomize 'Tells VB to use system timer for seed value when generating
' random numbers
' This part of the procedure generates the random numbers and assigns
' them to the array
Do While Counter < 10 'Loop until all values are assigned
Used = False
RandNum = Int((10 - 1 + 1) * Rnd + 1) 'Generates random number between 1-10 (see Help)
If Counter = 0 Then 'If first time, assigns number to first element
MyArray(1, 1) = RandNum ' and increments counter
Counter = Counter + 1
Else 'If it's not the first time through the loop
For i = 1 To Counter 'For every number in the array
If RandNum = MyArray(1, i) Then 'Compare new number to numbers already assigned
Used = True 'If found, then set the flag and exit the loop
Exit For
End If
Next i
If Used = False Then 'If the number does not exist in the array
MyArray(1, Counter + 1) = RandNum ' then assign it to the next element
Counter = Counter + 1 ' and increment the counter
End If
End If
Loop
' This part of the procedure assigns the strings to the array based
' on the value
For i = 1 To 10 'For each number in the array
Select Case MyArray(1, i) ' compare the value and assign the appropriate
Case Is < 5 ' string value
MyArray(2, i) = "Smaller"
Case Is = 5
MyArray(2, i) = "Equal"
Case Else
MyArray(2, i) = "Bigger"
End Select
Next i
' The part of the procedure displays the values that are even
For i = 1 To 10 'For each number array, see if the remainder
If MyArray(1, i) Mod 2 = 0 Then ' is zero when divided by two (= even number)
MsgBox "Number = " & MyArray(1, i) & " String = " & MyArray(2, i)
End If
Next i
End Sub
Module 1 - Lesson 4 Exercises Page 1-34
1. Only one difference: function will return a value.
2. He/she can use the IsMissing function within an If statement to check to see if the argument has been passed to the function. IsMissing will return True if no argument was passed and will return False if it was.
3.
Function MyPoser(pNumber)
MyPower = pNumber ^ .05 * 6
End Function
Module 1 - Lesson 5 Exercises Page 1-43
1. Yes, highlight the variable to watch in the code pane of the Debug window, press the Instant Watch Tool on the Visual Basic toolbar and choose the Add button. Or choose Tools Add Watch.
2.
Sub GetFile()
Dim goodFile As Boolean
On Error GoTo errorHandler
Do
goodFile = True
fileName = InputBox(prompt:="Enter a filename")
if fileName = "" Then Exit Sub
FileOpen fileName
If goodFile Then Exit Sub
Loop
errorHandler:
goodFile = False
Msg = "The file, " & fileName & ", is either already open or not available."
x = Application.Message(Message:=Msg, Type:=pjYesNo, _
YesText:="Try Again", NoText:="Exit Procedure")
If x = True Then Resume Next
End Sub
Module 2 - Lesson 1
Exercise2: (MoveRect) Page 2-6
Sub MoveRect()
FileSave
For i = 1 To 5
SelectCellRight 2
SelectCellDown 2
SelectCellLeft 2
SelectCellUp 2
Next i
FileClose
End Sub
Exercise: (ApplyAView) Page 2-10
Sub ApplyAView()
test = False
myView = InputBox("Enter a View to display: ")
For Each item In ActiveProject.TaskViewList
If LCase(item) = LCase(myView) Then
ViewApply Name:=myView
test = True
End If
Next item
If test = False Then MsgBox "View Does not exist"
End Sub
Module 2 - Lesson 2
Exercise1: (TaskTraverse) Page 2-16
Sub TaskTraverse()
For Each t In ActiveProject.Tasks
If t.Duration > 5 * 480 Then t.Duration = t.Duration * 0.9
If t.Summary Then
If t.OutlineChildren > 5 Then t.OutlineHideSubtasks
End If
Next t
End Sub
Module 2 - Lesson 2 (continued)
Exercise2: (TaskLink) Page 2-16
Sub TaskLink()
For Each t In ActiveProject.Tasks
i = 0
If t.Summary Then
If t.OutlineChildren > 1 Then
idTmp1 = t.ID + 1
idTmp2 = t.ID + 2
ActiveProject.Tasks(idTmp2).LinkPredecessors _
Tasks:=ActiveProject.Tasks(idTmp1)
End If
End If
Next t
End Sub
Exercise1: Page 2-18
Sub ResMaxUnits()
RName = InputBox("Enter the name of the resource to edit")
RMax = InputBox("The Max Units for " & RName & " is " & _
ActiveProject.Resources(RName).GetField(FieldID:=pjMaxUnits) _
& " Do you want to Change it? Y/N")
If RMax = "y" Then
ActiveProject.Resources(RName).MaxUnits = _
InputBox("Enter new value")
End If
End Sub
Exercise1: (AssignWork1) Page 2-20
Sub AssignWork1()
RName = InputBox("Enter the name of the resourse to remove work from:")
For Each t In ActiveProject.Tasks
For Each r In t.Assignments
If r.ResourceName = RName Then r.Work = r.Work - 60
Next r
Next t
End Sub
Module 2 - Lesson 2 (continued)
Exercise2: (AssignWork2) Page 2-20
Sub AssignWork2()
For Each t In ActiveProject.Tasks
For Each r In t.Assignments
If r.ResourceName = t.Text1 Then r.Work = r.Work + r.Work * 0.2
Next r
Next t
End Sub
Module 2 - Lesson 3
Exercise1: (CalRangeSet) Page 2-26
Sub CalRangeSet()
DRangeStart = InputBox("Enter the Start date of the break")
DRangeFinish = InputBox("Enter the Finish date of the break")
ActiveProject.BaseCalendars("Standard") _
.Period(DRangeStart, DRangeFinish).Working = False
End Sub
Exercise2: (CalTaskMove) Page 2-26
Sub CalTaskMove()
Dim newTime As String
newTime = InputBox("Enter the a duration")
x = ActiveProject.Tasks(ActiveCell.Task.ID - 1).Start
ActiveCell.Task.Start = DateAdd(x, newTime)
End Sub
Module 3 - Lesson 1 Exercises Page 3-18
1.
Sub M3L1E1()
Dim MyErr As Integer, msg As String
On Error Resume Next
AppActivate "Microsoft Project"
MyErr = Err
On Error GoTo 0
If MyErr > 0 Then
msg = "Make sure Microsoft Project is running " & _
"before using this macro."
MsgBox msg
End If
End Sub
2.
Sub M3L1E2()
Dim MyErr As Integer, response As Integer
On Error Resume Next
AppActivate "Microsoft Excel"
MyErr = Err
On Error GoTo 0
If MyErr > 0 Then
msg = "Excel is not running. Do you want to start it?"
response = MsgBox(msg, vbYesNo)
If response = vbYes Then
AppExecute command:="Excel" 'or use Shell with full path
Else
End 'don't need this; macro ends anyway
End If
End If
End Sub
Module 3 - Lesson 1 Exercises (continued)
3.
Sub M3L1E3()
Dim msg As String, response As String, MyErr As Integer
On Error Resume Next
AppActivate "Microsoft Excel"
MyErr = Err
On Error GoTo 0
If MyErr > 0 Then
AppExecute command:="Excel" 'or use Shell with full path
Else
AppActivate "Microsoft Project" 'so next msg can be seen
msg = "Excel is already running. You can switch to it, " & _
"or start a new instance."
response = Message(msg, pjYesNoCancel, "Current", "New")
If response = True Then 'Current (Yes) button
AppActivate "Microsoft Excel"
ElseIf response = False Then 'New (No) button
Shell "D:\Excel5\Excel.exe", 3 'Shell new instance
Else 'Cancel button
End 'don't need this; macro ends anyway
End If
End If
End Sub
4.
Sub M3L1E4()
Dim MyErr As Integer
On Error Resume Next
AppActivate "Microsoft Excel"
MyErr = Err
On Error GoTo 0
If MyErr = 0 Then
SendKeys "%{F4}" 'Send Alt-F4 to close it
End If
End Sub
Module 3 - Lesson 2 Exercises Page 3-23
1.
Sub M3L2E1()
Dim s As String
s = InputBox("Enter some text.")
Shell "Notepad.exe", 3
SendKeys s
End Sub
2.
Sub M3L2E2()
ViewApply Name:="&Gantt Chart"
SelectTaskColumn Column:="Name"
EditCopy
Shell "NotePad.exe", 3
SendKeys "%EP"
End Sub
3.
Sub M3L2E3()
Dim T As Object
Shell "NotePad.exe", 3
For Each T In ActiveProject.Tasks
SendKeys T.Name
SendKeys "{Enter}"
Next
End Sub
4.
Sub M3L2E4()
SendKeys "If Then"
SendKeys "{Enter 2}"
SendKeys "End If"
SendKeys "{Up 2}"
SendKeys "{Left 3}"
End Sub
Module 3 - Lesson 3 Exercises Page 3-49
1.
Step (13): In the Form_Load, cmdPrevious_Click, and cmdNext_Click procedures, replace the two lines
lblTaskName = oTask.Name
txtDuration = oTask.GetField(29)
with the following lines:
If oTask Is Nothing Then
lblTaskName = ""
txtDuration = ""
Else
lblTaskName = oTask.Name
txtDuration = oTask.GetField(29)
End If
And the new cmdUpdate_Click procedure is:
Sub cmdUpdate_Click ()
If oTask Is Nothing Then
MsgBox "Task is blank"
txtDuration = ""
Else
oTask.Duration = txtDuration
End If
End Sub
Step (14): A command button was created, labeled "GoTo", and its Name property was changed to cmdGoto. The click procedure is shown below:
Sub cmdGoto_Click ()
Dim N As Integer
On Error Resume Next
N = InputBox("Enter task id")
Set oTask = oMSP.activeproject.tasks(N)
If Err > 0 Then
MsgBox "Bad ID"
Exit Sub
End If
nTaskID = N
lblTaskID = nTaskID
If oTask Is Nothing Then
lblTaskName = ""
txtDuration = ""
Else
lblTaskName = oTask.Name
txtDuration = oTask.GetField(29)
End If
End Sub
Module 3 - Lesson 3 Exercises (continued)
2.
Sub m3l3e2()
Dim P As Object
Set P = CreateObject("MSProject.Project")
P.Tasks.Add Name:="a"
P.Tasks.Add Name:="b"
P.Tasks.Add Name:="c"
P.Tasks(2).Predecessors = 1
P.Tasks(3).Predecessors = 2
End Sub
3.
Sub M3L3E3()
Dim oMSP As Object, T As Object
Dim N As Integer, R As Integer
Set oMSP = CreateObject("MSProject.Application")
oMSP.Visible = True
AppActivate "Microsoft Project"
oMSP.FileNew
N = Sheets("Sheet1").Cells(1, 1).CurrentRegion.Rows.Count
For R = 1 To N
Set T = oMSP.ActiveProject.Tasks _
.Add(Name:=Sheets("sheet1").Cells(R, 1).Value)
T.Start = Sheets("sheet1").Cells(R, 2).Value
T.Duration = Sheets("sheet1").Cells(R, 3).Value
Next
End Sub
4. A command button named cmdClose and a listbox named List1 was created on Form1 in VB3. The code is shown below:
Sub Form_Load ()
Dim oMSP As object, oTasks As object
Dim n As Integer
Set oMSP = GetObject(, "msproject.application")
Set oTasks = oMSP.ActiveProject.Tasks
For n = 1 To oTasks.Count
If Not oTasks(n) Is Nothing Then
List1.AddItem oTasks(n).Id & " " & oTasks(n).Name
End If
Next
End Sub
Sub cmdClose_Click ()
End
End Sub
Module 3 - Lesson 3 Exercises (continued)
5. A command button named cmdClose and a listbox named List1 was created on Form1 in VB3. The code is shown below:
Sub Form_Load ()
Dim oMSP As object, oResources As object
Dim n As Integer
Set oMSP = GetObject(, "msproject.application")
Set oResources = oMSP.ActiveCell.Task.Resources
For n = 1 To oResources.Count
List1.AddItem oResources(n).Name
Next
End Sub
Sub cmdClose_Click ()
End
End Sub
6.
Sub M3L3E6()
Dim x As Object, T As Object, R As Integer
Set x = CreateObject("Excel.Application")
x.Workbooks.Add
R = 1
For Each T In ActiveProject.Tasks
If Not T Is Nothing Then
x.ActiveSheet.Cells(R, 1).Value = T.Name
x.ActiveSheet.Cells(R, 2).Value = T.GetField(29)
R = R + 1
End If
Next
x.ActiveWorkbook.Close SaveChanges:=True
x.Quit
End Sub
Module 3 - Lesson 3 Exercises (continued)
7.
Sub M3L3E7()
Dim x As Object, T As Object, s As Object
Dim R As Integer, MyErr As Integer
On Error Resume Next
AppActivate "microsoft excel"
MyErr = Err
On Error GoTo 0
If MyErr > 0 Then
AppExecute command:="Excel.exe"
AppActivate "Microsoft Excel"
End If
Set x = GetObject(, "Excel.Application")
x.WindowState = pjMaximized
x.Workbooks.Add
Set s = x.ActiveSheet
R = 1
For Each T In ActiveProject.Tasks
If Not T Is Nothing Then
s.Cells(R, 1).Value = T.Name
s.Cells(R, 2).Value = _
T.Duration / 60 / ActiveProject.HoursPerDay
R = R + 1
End If
Next
x.Charts.Add
x.ActiveChart.ChartWizard _
Source:=s.Cells(1, 1).CurrentRegion, _
PlotBy:=2, _
CategoryLabels:=1
End Sub
Module 3 - Lesson 4 Exercises Page 3-73
1. The MSProject macro:
Sub AllOneDay()
Dim T As Object
For Each T In ActiveProject.Tasks
If Not T Is Nothing Then
T.Duration = "1d"
End If
Next
End Sub
The Excel DDE macro:
Sub M3L4E1a()
Dim SystemChannel As Integer
SystemChannel = DDEInitiate("winproj", "system")
DDEExecute SystemChannel, "AllOneDay"
DDETerminate SystemChannel
End Sub
The Excel OLE macro:
Sub M3L4E1b()
Dim oMSP As Object
Set oMSP = CreateObject("MSProject.Application")
oMSP.Macro "AllOneDay"
End Sub
2. The MSProject macro:
Sub IncreaseCost(TaskID As Integer, CostChange As Currency)
Dim T As Object
Set T = ActiveProject.Tasks(TaskID)
T.FixedCost = T.FixedCost + CostChange
End Sub
The Excel macro:
Sub M3L4E2()
Dim SystemChannel As Integer
SystemChannel = DDEInitiate("winproj", "system")
DDEExecute SystemChannel, "IncreaseCost 1, 10.5"
DDETerminate SystemChannel
End Sub
Module 3 - Lesson 5 Exercises Page 3-83
1. "Microsoft Project 4.0 Project Object" and "Picture". Paste Link is not available.
2.
Sub M3L5E2()
Dim x As Object
Set x = GetObject(, "Excel.Application")
x.Range("A1:D3").Select
x.Selection.Copy
ViewApply Name:="Task Form"
EditGoTo ID:=3
ViewShowObjects
EditPaste
End Sub
3.
Sub M3L5E3()
Dim x As Object
ViewApply "Gantt Chart"
SelectAll
EditCopy
Set x = CreateObject("Word.Basic")
x.EditPaste
End Sub
Module 3 - Lesson 6 Exercises Page 3-92
1.
Sub M3L6E1()
Dim fnum As Integer
Dim otask As Object
Dim sFileName
sFileName = InputBox("Enter a path and filename")
fnum = FreeFile()
Open sFileName For Output As fnum
For Each otask In ActiveProject.Tasks
If Not otask Is Nothing Then
Write #fnum, otask.UniqueID, CStr(otask.Start)
End If
Next
Close fnum
End Sub
2.
Sub M3L6E2()
Dim fnum As Integer, otask As Object
Dim Uid As Long, Dur As String, MyErr As Integer
fnum = FreeFile()
Open "C:\M3L6E2.txt" For Input As fnum
Do Until EOF(fnum)
Input #fnum, Uid, Dur
On Error Resume Next
ActiveProject.Tasks.UniqueID(Uid).Duration = Dur
MyErr = Err
On Error GoTo 0
If MyErr > 0 Then
MsgBox "There is no task with unique id = " & Uid
End If
Loop
Close fnum
End Sub
Module 3 - Lesson 7 Exercises Page 3-100
1.
Sub M3L7E1()
Dim r As Object
For Each r In ActiveProject.Resources
If Not r Is Nothing Then
MailSend To:=r.EMailAddress, _
Subject:="Rates", _
Body:=" Standard Rate: " & r.StandardRate & Chr(10) _
& " Overtime Rate: " & r.OvertimeRate, _
IncludeDocument:=False
End If
Next
End Sub
2.
Sub M3L7E2()
Dim r As Object
For Each r In ActiveProject.Resources
If Not r Is Nothing Then
MailSend To:=r.EMailAddress, _
Subject:="Multiline Notes", _
Body:=r.GetField(pjResourceNotes), _
IncludeDocument:=False
End If
Next
End Sub
3.
Sub M3L7E3()
ViewApply "Gantt Chart"
SelectAll
MailSendProjectMail MessageType:="TaskRequest", _
Subject:="Assignments", _
Body:="Respond ASAP", _
Fields:="Resource Names", _
ShowDialog:=False
End Sub
Module 3 - Lesson 8 Exercises Page 3-115
1.
'********************************************************
'Put in the declarations section
Declare Function GetActiveWindow Lib "USER" () As Integer
Declare Sub SetWindowPos Lib "USER" _
(ByVal hWnd As Integer, _
ByVal hWndInsertAfter As Integer, _
ByVal x As Integer, ByVal Y As Integer, _
ByVal cx As Integer, ByVal cy As Integer, _
ByVal wFlags As Integer)
Global Const HWND_TOPMOST = -1
Global Const SWP_NOSIZE = &h1
Global Const SWP_NOMOVE = &h2
'********************************************************
Sub M3L8E1()
Shell "Calc.exe", 1
DoEvents 'Precaution- Give it a chance to open.
AppActivate "Calculator" 'Precaution- Make sure it's active
SetWindowPos GetActiveWindow(), _
HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
End Sub
Module 3 - Lesson 8 Exercises (continued)
2.
'********************************************************
'Put in the declarations section
Declare Function GetActiveWindow Lib "USER" () As Integer
Declare Function OpenClipboard Lib "USER" _
(ByVal hWnd As Integer) As Integer
Declare Function EmptyClipboard Lib "USER" () As Integer
Declare Function GetClipboardData Lib "USER" _
(ByVal wFormat As Integer) As Integer
Global Const CF_TEXT = 1
Declare Function CloseClipboard Lib "USER" () As Integer
Declare Function GlobalLock Lib "KERNEL" _
(ByVal hMem As Integer) As Long
Declare Function GlobalUnlock Lib "KERNEL" _
(ByVal hMem As Integer) As Integer
Declare Function lstrcpyn Lib "KERNEL" _
(ByVal lpString1 As Any, ByVal lpString2 As Any, _
ByVal nChars As Integer) As Long
'********************************************************
Sub M3L8E2()
Dim MemoryBlockId As Integer
Dim MemoryBlockAddress As Long
Dim s As String * 5 'Reserve room for "hello"
OpenClipboard GetActiveWindow()
EmptyClipboard
CloseClipboard
Do
DoEvents
OpenClipboard GetActiveWindow()
MemoryBlockId = GetClipboardData(CF_TEXT)
MemoryBlockAddress = GlobalLock(MemoryBlockId)
lstrcpyn s, MemoryBlockAddress, 6 'must specify one higher
GlobalUnlock MemoryBlockId
CloseClipboard
Loop Until s = "hello"
MsgBox "goodbye"
End Sub