222 lines
5.0 KiB
Plaintext
222 lines
5.0 KiB
Plaintext
<%
|
|
'EXCEL
|
|
Dim xls, I, J, tempName, tempPath, tempnum
|
|
|
|
On Error Resume Next
|
|
|
|
Set xls = CreateObject("Excel.Application")
|
|
|
|
With xls
|
|
' Make sure there is no minimized window created
|
|
.Application.Visible = False
|
|
|
|
' Add a new workbook
|
|
.Workbooks.Add
|
|
|
|
' Select some cells to put the DATETIME in it
|
|
|
|
.Range("A1:C1").Select
|
|
.Selection.MergeCells = True
|
|
.Selection = Now
|
|
|
|
' populate some cells
|
|
For I = 2 To 15
|
|
For J = 2 To 20
|
|
tempnum = 12
|
|
If J = 15 Then
|
|
.Cells(J, I).Value = Sqr(i*j) / (i^tempnum)
|
|
ElseIf J = 10 Then
|
|
.Cells(J, I).Value = (i+j) * (i^tempnum)
|
|
Else
|
|
.Cells(J, I).Value = (i+j)^2
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
.Charts.Add
|
|
.ActiveChart.ChartType = 67 'xlLineMarkersStacked100 = 67
|
|
' xlColumns = 2
|
|
.ActiveChart.SetSourceData .Sheets("Sheet1").Range("B2:O20"), 2
|
|
' xlLocationAsNewSheet = 1
|
|
.ActiveChart.Location 1
|
|
With .ActiveChart
|
|
.HasTitle = True
|
|
.ChartTitle.Characters.Text = "My Kewl Chart number #" & CStr(tempnum)
|
|
.Axes(1, 1).HasTitle = True
|
|
.Axes(1, 1).AxisTitle.Characters.Text = "X axis for you"
|
|
.Axes(2, 1).HasTitle = True
|
|
.Axes(2, 1).AxisTitle.Characters.Text = "Y axis for me"
|
|
End With
|
|
With .ActiveChart.Axes(1)
|
|
.HasMajorGridlines = True
|
|
.HasMinorGridlines = False
|
|
End With
|
|
With .ActiveChart.Axes(2)
|
|
.HasMajorGridlines = True
|
|
.HasMinorGridlines = False
|
|
End With
|
|
|
|
.ActiveChart.HasLegend = True
|
|
.ActiveChart.Legend.Select
|
|
' xlBottom = -4107
|
|
.Selection.Position = -4107
|
|
' xlDataLabelsShowNone = -4142
|
|
.ActiveChart.ApplyDataLabels -4142, False
|
|
.ActiveChart.HasDataTable = False
|
|
|
|
' Make a path for the file to be saved
|
|
|
|
tempName = Hour(Now) & Minute(Now) & Second(Now) & ".xls"
|
|
tempPath = "d:inetpubwwwroot esting" & tempName
|
|
|
|
' Save the Workbook in my web drive
|
|
|
|
.Application.DisplayAlerts = False
|
|
.Sheets("Sheet2").Select
|
|
.ActiveWindow.SelectedSheets.Delete
|
|
.Sheets("Sheet3").Select
|
|
.ActiveWindow.SelectedSheets.Delete
|
|
.Sheets("Chart1").Select
|
|
|
|
.Application.DisplayAlerts = True
|
|
|
|
.ActiveWorkbook.SaveAs tempPath
|
|
|
|
'.ActiveWorkBook.PrintOut 1
|
|
|
|
.ActiveWorkbook.Close
|
|
|
|
' VERY IMPORTANT HERE
|
|
' Quit the Application
|
|
' xls.Quit is NOT enough...is it only the reference to the Excel Object
|
|
' you still have to terminate the Application
|
|
|
|
.Application.Quit
|
|
End With
|
|
|
|
' VERY IMPORTANT HERE
|
|
' Release the memory
|
|
Set xls = Nothing
|
|
|
|
'***********************************
|
|
'WORD
|
|
|
|
Dim wrd, doc, filepath, filename
|
|
|
|
On Error Resume Next
|
|
|
|
Set wrd = CreateObject("Word.Application")
|
|
|
|
With wrd
|
|
' Make sure there is no minimized window created
|
|
.Application.Visible = False
|
|
|
|
' Add a new document
|
|
|
|
.Documents.Add
|
|
|
|
filepath = "d:inetpubwwwroot"
|
|
filename = "silly" & Second(Now) & ".doc"
|
|
|
|
.ActiveDocument.SaveAs filepath & filename, 0 ' Word Document Format
|
|
|
|
doc = "This is a document" & vbCrLf
|
|
doc = doc & "IDENTIFICATION: ME!!!" & vbCrLf
|
|
doc = doc & Date & vbCrLf
|
|
doc = doc & filepath & vbCrLf & vbCrLf
|
|
doc = doc & "WHAT DO YOU WANT???"
|
|
|
|
With .Selection
|
|
.Selection.TypeText doc
|
|
.Selection.WholeStory
|
|
.Selection.Font.Name = "Courier New"
|
|
.Selection.Font.Bold = True
|
|
.Selection.Font.Italic = True
|
|
.Selection.Font.Size = 32
|
|
.Selection.HomeKey
|
|
End With
|
|
|
|
.ActiveDocument.Close -1 'Save Changes
|
|
|
|
' VERY IMPORTANT HERE
|
|
' Quit the Application
|
|
' wrd.Quit is NOT enough...is it only the reference to the Word Object
|
|
' you still have to terminate the Application
|
|
|
|
.Application.Quit
|
|
End With
|
|
|
|
' VERY IMPORTANT HERE
|
|
' Release the memory
|
|
Set wrd = Nothing
|
|
|
|
'***********************************
|
|
'MSACCESS
|
|
|
|
Dim msa, I, J, tempName, tempPath, tempnum
|
|
Dim Mywk, newDb
|
|
|
|
On Error Resume Next
|
|
|
|
Set msa = CreateObject("Access.Application")
|
|
|
|
tempName = Hour(Now) & Minute(Now) & Second(Now) & ".mdb"
|
|
tempPath = "d:inetpubwwwroot esting" & tempName
|
|
|
|
Set Mywk = msa.DBEngine.Workspaces(0)
|
|
Set newDb = Mywk.CreateDatabase(tempPath, ";LANGID=0x0409;CP=1252;COUNTRY=0")
|
|
|
|
newDb.close
|
|
Mywk.Close
|
|
Set newDb = Nothing
|
|
Set Mywk = Nothing
|
|
|
|
msa.Application.Quit
|
|
|
|
Set msa = Nothing
|
|
|
|
'***********************************
|
|
'POWERPOINT
|
|
'***********************************
|
|
Dim ppt, I, J, tempName, tempPath, tempnum
|
|
|
|
On Error Resume Next
|
|
|
|
Set ppt = CreateObject("PowerPoint.Application")
|
|
|
|
tempName = Hour(Now) & Minute(Now) & Second(Now) & ".ppt"
|
|
tempPath = "d:inetpubwwwroot esting" & tempName
|
|
|
|
ppt.Presentations.Add -1
|
|
ppt.ActiveWindow.View.GotoSlide ppt.ActivePresentation.Slides.Add(1, 12).SlideIndex
|
|
|
|
ppt.ActiveWindow.Selection.SlideRange.Shapes.AddLabel(1, 114, 156, 474, 36).Select
|
|
ppt.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(1, 0).Select
|
|
|
|
With ppt.ActiveWindow.Selection.TextRange
|
|
.Text = "WOW THIS WORKS!!!"
|
|
With .Font
|
|
.Name = "Times New Roman"
|
|
.Size = 24
|
|
.Bold = 0
|
|
.Italic = 0
|
|
.Underline = 0
|
|
.Shadow = -1
|
|
.Emboss = 0
|
|
.BaselineOffset = 0
|
|
.AutoRotateNumbers = 0
|
|
.Color.SchemeColor = 2
|
|
End With
|
|
End With
|
|
|
|
ppt.ActiveWindow.Selection.Unselect
|
|
ppt.ActivePresentation.SaveAs tempPath
|
|
ppt.ActivePresentation.Close
|
|
|
|
' there is no Application object for PPT, so just quit ppt
|
|
ppt.Quit
|
|
|
|
' Release the memory to PPT
|
|
Set ppt = Nothing
|
|
%>
|