我用EXCLE做了一个小软件.想用VB把它独立出来,有没有办法,简单一点的办法.因本人不懂VB.谢谢!!
本论谈有相关贴子啊。。。。。。
算了。。。下面是我做的。。你看下吧
多多关注VB就知道了。。。
Dim objCn As New Connection
Dim objRs As New Recordset
Private Sub Command2_Click()
Dim strQuery As String
Label4.Caption = "be ready.............."
If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Then
Label4.Caption = "check,please.............."
MsgBox "MakeReamID is not allow empty!"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
If Trim(Text3.Text) = "" Then
Label4.Caption = "check,please.............."
MsgBox "Product ID is not allow empty!"
Text3.SetFocus
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
Exit Sub
End If
Frame1.Enabled = False
Label4.Caption = "wait a jiff.............."
Set objCn = Nothing
Set objRs = Nothing
objCn.Open "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Initial Catalog=Leader;Data Source=192.168.0.2"
strQuery = "select c.TA001,c.TA002,c.TA015,a.MD001,a.MD016 ,a.MD003 ,b.MB002 ,b.MB003 ,b.MB004 ,a.MD006 ,c.TA015 * a.MD006 " & _
"from BOMMD a right join INVMB b on a.MD003=b.MB001 left join MOCTA c on a.MD001=c.TA006 " & _
"where a.MD001='" & Text3.Text & "' and c.TA001='" & Text1.Text & "' and c.TA002='" & Text2.Text & "'"
objRs.Open strQuery, objCn, adOpenKeyset, adLockOptimistic
Dim rstCount As Long '记录行数
Dim rstField As Long '记录列数
rstCount = objRs.RecordCount
rstField = objRs.Fields.Count
If rstCount <= 0 Then
Frame1.Enabled = True
Label4.Caption = "check,please.............."
MsgBox "nothing,check,please...!"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Exit Sub
End If
Dim mExApp As Excel.Application '应用
Dim mExBook As Excel.Workbook '工作薄
Dim mExSheet As Excel.Worksheet '工作表
Set mExApp = CreateObject("Excel.Application")
Set mExBook = mExApp.Workbooks.Open(App.Path & "\MakeReam.xls")
Set mExSheet = mExBook.Worksheets(1)
Dim lLine As Long
Dim Column As Long
Dim sCellValue As String
lLine = 1
'写列头
For Column = 0 To rstField - 5
Select Case Column
Case 0
sCellValue = "部位名称"
Case 1
sCellValue = "材料编号"
Case 2
sCellValue = "材料名称"
Case 3
sCellValue = "规格"
Case 4
sCellValue = "单位"
Case 5
sCellValue = "单耗"
Case 6
sCellValue = "总用量"
End Select
mExSheet.Cells(lLine, Column + 1) = sCellValue
If Column = 6 Then mExSheet.Cells(lLine, Column + 2) = "备注"
Next Column
'开始内容
For lLine = 2 To rstCount + 1
For Column = 0 To rstField - 5
sCellValue = objRs.Fields(Column + 4)
mExSheet.Cells(lLine, Column + 1) = sCellValue
Next Column
objRs.MoveNext '下一行数据
Next lLine
'自动调整列
For Column = 1 To rstField - 4
mExSheet.Columns(Column).AutoFit
Next
'输出该表
objRs.Requery
mExBook.SaveAs (Trim(objRs.Fields(1)) & "-" & Trim(objRs.Fields(3)) & ".xls") '保存
mExBook.Close (True) '按内容变化关闭
Label4.Caption = "successful!"
' this shows a messagebox that will be dismissed after 4 seconds
'
' set the callback timer and pass our application defined ID (NV_CLOSEMSGBOX)
' set the time for 3 seconds (3000& microseconds)
' SetTimer hWnd, NV_CLOSEMSGBOX, 3000&, AddressOf TimerProc
'
' call the messagebox API function
' Call messagebox(hWnd, "InTo Excel successful!", MB_ICONQUESTION Or MB_TASKMODAL)
MsgBox "InTo Excel successful!"
Frame1.Enabled = True
Label4.Caption = "input data..........."
Text1 = "": Text2 = "": Text3 = ""
Text1.SetFocus
End Sub