Public Sub OutDataToExcel(Flex As MsFlexGrid) '导出至Excel
Dim s As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo Ert
Dim Excelapp As Excel.Application
Set Excelapp = New Excel.Application
On Error Resume Next
DoEvents
Excelapp.SheetsInNewWorkbook = 1
Excelapp.Workbooks.Add
Excelapp.ActiveSheet.Cells(1, 3) = s
Excelapp.Range("C1").Select
Excelapp.Selection.Font.FontStyle = "Bold"
Excelapp.Selection.Font.Size = 16
With Flex
k = .Rows
For i = 0 To k - 1
For j = 0 To .Cols - 1
DoEvents
Excelapp.ActiveSheet.Cells(3 + i, j + 1) = "'" & .TextMatrix(i, j)
Next j
Next i
End With
Ert:
If Not (Excelapp Is Nothing) Then
Excelapp.Quit
End If
End Sub
Option Explicit
Public appdisk As String
Public conn As New ADODB.Connection
Public rs As New ADODB.Recordset
Public db As String
Private Sub Form_Load()
appdisk = Trim(App.Path)
If Right(appdisk, 1) <> "\" Then appdisk = appdisk & "\"
db = appdisk
db = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & db & "alex.mdb"
conn.CursorLocation = adUseClient
conn.Open db
rs.Open "aaa", conn, adOpenKeyset, adLockPessimistic
End Sub
Private Sub Command1_Click()
Dim lRow As Long
Dim sXLSPath As String
Dim MyExcel As New Excel.Application
Dim MyBook As Excel.Workbook
Dim MySheet As Excel.Worksheet
Screen.MousePointer = 11
sXLSPath = appdisk & "maindata.xls"
Open sXLSPath For Output As #1
Close #1
Set MyExcel = CreateObject("excel.application")
Set MyBook = MyExcel.Workbooks.Open(sXLSPath)
Set MySheet = MyExcel.ActiveSheet
MySheet.Range("A1:O1").Select
With MyExcel.Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
MySheet.Columns("A:C").NumberFormat = "0_ "
MySheet.Columns(1).ColumnWidth = 5
MySheet.Columns(2).ColumnWidth = 10
MySheet.Columns(3).ColumnWidth = 10
MySheet.Columns(4).ColumnWidth = 10
MySheet.Columns(5).ColumnWidth = 10
MySheet.Columns(6).ColumnWidth = 10
MySheet.Columns(7).ColumnWidth = 10
MySheet.Columns(8).ColumnWidth = 10
MySheet.Columns(9).ColumnWidth = 10
MySheet.Cells(1, 1) = "proid"
MySheet.Cells(1, 2) = "product"
MySheet.Cells(1, 3) = "batchno"
MySheet.Cells(1, 4) = "seqno"
If rs.EOF = True Then
rs.Close: Set rs = Nothing
Screen.MousePointer = 0
Exit Sub
End If
Do While rs.EOF = False
lRow = lRow + 1
MySheet.Cells(lRow + 1, 1) = rs.Fields("seqno")
MySheet.Cells(lRow + 1, 2) = rs.Fields("weight")
MySheet.Cells(lRow + 1, 3) = rs.Fields("unitprc")
MySheet.Cells(lRow + 1, 4) = rs.Fields("account")
rs.MoveNext
Loop
rs.Close: Set rs = Nothing
MyExcel.DisplayAlerts = False
MyBook.SaveAs FileName:=appdisk & "maindata.xls", FileFormat:=xlNormal, Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MyBook.Application.Quit
MyExcel.Application.Quit
Set MySheet = Nothing
Set MyBook = Nothing
Set MyExcel = Nothing
Screen.MousePointer = 0
MsgBox "Successful Established Excell File Maindata.xls", vbOKOnly, "Bawang Electronic Price Scale"
End Sub