'=========================================================
'==            Visual Basic Sample Code From            ==
'==     Microsoft Excel/Visual Basic for Windows 95     ==
'==                  Programmer's Guide                 ==
'==                      Chapter 10                     ==
'=========================================================

' DISCLAIMER OF WARRANTY

' THIS FILE CONTAINS UNDOCUMENTED SAMPLE CODE. THIS SAMPLE CODE IS 
' PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT FURTHER
' DISCLAIMS ALL IMPLIED WARRANTIES INCLUDING WITHOUT LIMITATION ANY
' IMPLIED WARRANTIES OF MERCHANTABILITY OR OF FITNESS FOR A PARTICULAR
' PURPOSE. THE ENTIRE RISK ARISING OUT OF THE USE OR PERFORMANCE OF THE
' SAMPLE CODE REMAINS WITH YOU.

' IN NO EVENT SHALL MICROSOFT OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES
' WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF
' BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION,
' OR OTHER PECUNIARY LOSS) ARISING OUT OF THE USE OF OR INABILITY TO USE
' THIS SAMPLE CODE, EVEN IF MICROSOFT HAS BEEN ADVISED OF THE POSSIBILITY
' OF SUCH DAMAGES. BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR
' LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE
' ABOVE LIMITATION MAY NOT APPLY TO YOU.






'=========================================================
'==                    From Page 195                    ==
'=========================================================

Dim projapp As Object

Set projapp = CreateObject("MSProject.Application")

'-------------------------------------------------

Dim projapp As Object

Set projapp = CreateObject("MSProject.Project")

'-------------------------------------------------

Dim projapp As Object

Set projapp = GetObject("", "MSProject.Application")





'=========================================================
'==                 From Pages 196-197                  ==
'=========================================================

Dim proj as Object
Dim nameoftask As String
Dim writetime As Integer, edittime As Integer, incorptime As Integer
Dim busytime As Integer, i As Integer, mecount As Integer
Dim othercount As Integer, timespent As Integer

Set proj = GetObject("c:\winproj\MyProject.mpp", "msproject.project")
mecount = 0
othercount = 0

For i = 1 To proj.tasks.Count
	If proj.tasks(i).Resources.Count > 0 Then
	With proj.tasks(i)
		If .Resources(1).Name = "Jane Smith" Then
			timespent = .Duration
			Select Case .Name
				Case "write"
					writetime = writetime + timespent
				Case "incorp. tech review"
					incorptime = incorptime + timespent
				Case "edit incorp.", "review/edit merged art"
					edittime = edittime + timespent
				Case "art to designer", "hand-off to production"
					busytime = busytime + timespent
				Case Else
				MsgBox "Error " & .Name
			End Select
		End If
	End With
	End If
Next i

With Worksheets("sheet1")
	.Range("B1") = writetime
	.Range("B2") = incorptime
	.Range("B3") = busytime
	.Range("B4") = edittime

	.Range("A1") = "Writing"
	.Range("A2") = "Adding Changes"
	.Range("A3") = "Other"
	.Range("A4") = "Editing"
End With

proj.Application.Quit





'=========================================================
'==                    From Page 197                    ==
'=========================================================

Dim newEmbeddedChart As ChartObject

Set newEmbeddedChart = Worksheets(1).ChartObjects.Add(50, 50, 250, 250)
With newEmbeddedChart.Chart
	.ChartWizard Source:=Worksheets(1).Range("A1:B4"), _
		Gallery:=xlPie, Format:=7, PlotBy:=xlColumns, _
		CategoryLabels:=1, SeriesLabels:=0, HasLegend:=2
	.HasTitle = True
	.ChartTitle.Text = "My Schedule"
	.ChartTitle.Font.Color = RGB(0, 0, 255)
	.HasLegend = True
End With





'=========================================================
'==                    From Page 198                    ==
'=========================================================

Set pptApp = CreateObject("PowerPoint.Application.7")
Set pptPres = pptApp.Presentations.Add
Set pptSlide = pptPres.Slides.Add(1, 1)
Set pptSlideObj = pptSlide.Objects _
	.AddOleObject("Excel.Chart", 1000, 1000, 5000, 5000)
Set pptChart = pptSlideObj.Object
With pptChart
	.ChartWizard Source:=Worksheets("sheet1").Range("A1:B4"), _
		Gallery:=xlPie, Format:=7, PlotBy:=xlColumns, _
		CategoryLabels:=1, SeriesLabels:=0, HasLegend:=2
	.HasTitle = True
	.ChartTitle.Text = "My Schedule"
	.ChartTitle.Font.Color = RGB(0, 0, 255)
	.HasLegend = True
End With
pptPres.SaveAs "MayWork.ppt"

'-------------------------------------------------

Dim wdbasic As Object

Worksheets("sheet1").ChartObjects(1).Copy
Set wdbasic = CreateObject("word.basic")
With wdbasic
	.FileOpen "C:\msoffice\winword\MyDoc.doc"
	.EditPaste
	.FileSave
End With





'=========================================================
'==                    From Page 199                    ==
'=========================================================

wordobj.FormatDropCap 1, "Arial", 3, 6

'-------------------------------------------------

Dim wordobj As Object

Set wordobj = CreateObject("Word.Basic")
wordobj.toolsmacro "CreateDocandFormat", True

'-------------------------------------------------

proj.Application.Quit





'=========================================================
'==                    From Page 200                    ==
'=========================================================

Dim wdBasic As Object

Set wdBasic = CreateObject("word.basic")
wdBasic.FileOpen "C:\msoffice\winword\Speedup.doc"
Set wdBasic = Nothing

'-------------------------------------------------

Dim wordobj As Object

Worksheets("sheet1").OLEObjects(1).Verb
Set wordobj = Worksheets("sheet1").OLEObjects(1).Object _
	.Application.WordBasic
With wordobj
	.Insert "This is the new first line."
	.InsertPara
	.LineUp 1
	.EndOfLine 1
	.Bold
	.LineDown 1
End With





'=========================================================
'==                    From Page 201                    ==
'=========================================================

Dim wordobj As Object

Worksheets("sheet1").OLEObjects(1).Verb
Set wordobj = Worksheets("sheet1").OLEObjects(1).Object _
	.Application.WordBasic
With wordobj
	.Insert "Dear Mrs. Jones:"
	.InsertPara
	.FilePrint
	.FileClose
End With





'=========================================================
'==                    From Page 203                    ==
'=========================================================

Sub DemoSendKeys()
	returnvalue = Shell("calc.exe", 1)
	AppActivate returnvalue
	For i = 1 To 10
		SendKeys i & "{+}", True
		Next i
		SendKeys "=", True
		SendKeys "%{F4}", True
End Sub

'-------------------------------------------------

SendKeys "%{F4}", True


