3 replies to this topic

[mcj]

Galera estou fazendo uma página que irá ler um arquivo excel e exibir as informações na tela... tem como fazer isso? eu preciso ler colula por coluna e preciso ler descrições de colunas.

complicado isso?

[cybermix]

da proxima vez utilize a busca
resultado da busca

[jeffrm]

sua busca gera erro

da proxima vez utilize a busca
resultado da busca

[Patrique]

Não sei.... mais acho que isso pode te dar alguma luz.

'***********************************
'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:\inetpub\wwwroot\testing\" & 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:\inetpub\wwwroot\"
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:\inetpub\wwwroot\testing\" & 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:\inetpub\wwwroot\testing\" & 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