vb对Excel的操作问题
本帖最后由 u010752640 于 2013-06-19 11:52:39 编辑 我想做一个工具，首先在工具界面输入信息，接着检测设定文件夹中是否有规定命名的Excel文件，如果没有创建Excel文件。有的话直接打开，获取当前Excel文件内已经使用的列数。吧工具界面内的信息输入到已使用列数的下一列进行保存。但是我把这个工具做出来之后出现了一些问题，先是时不时的ActiveX部件不能创建对象。一会这个好了又会出现SaveAs错误。在不就是Sheets("sheet1").UsedRange.Rows.Count对象错误。过一会又能正常运行了。正常运行之后发现Excel文件只保存两列。在就不继续往下保存了。下面是代码求高人指点！
Public xlApp As Excel.Application
Public xlBook As Excel.Workbook
Public xlChar As New Excel.Chart
Public xlSheet As New Excel.Worksheet
Dim n As String
Dim y As String
Dim m As String
Dim d As String
Dim c As Integer
Private Sub Command1_Click()
Form2.Show
End Sub
Private Sub Command2_Click()
Unload Form1
End Sub
Public Sub Form_Load()
Dim Stri As String
Dim BStri As String
Dim PStri As String
Dim WStri As String
Open App.Path & "\Class.INI" For Input As #1
Do Until EOF(1)
Input #1, Stri
Combo1.AddItem Stri
Loop
Close #1
Open App.Path & "\Blance.INI" For Input As #1
Do Until EOF(1)
Input #1, BStri
Combo2.AddItem BStri
Loop
Close #1
Open App.Path & "\PartOrder.INI" For Input As #1
Do Until EOF(1)
Input #1, PStri
Combo4.AddItem PStri
Loop
Close #1
Open App.Path & "\Way.INI" For Input As #1
Do Until EOF(1)
Input #1, WStri
Combo3.AddItem WStri
Loop
Close #1
End Sub
Private Sub Command3_Click()
Dim Class As String
Dim FileName As String
Dim FileRequire As String
Dim PartDate As String
Dim Client As String
Dim Address As String
Dim Contact As String
Dim Blance As String
Dim Delivery As String
Dim Remark As String
Dim PartOrder As String
Dim Offer As String
Dim FactoryOffer As String
Class = Combo1.Text
FileName = Text1.Text
FileRequire = Text2
PartDate = Label5.Caption
Client = Text3.Text
Address = Text4.Text
Contact = Text5.Text
Blance = Combo2.Text
PartOrder = Combo3.Text
Delivery = Combo4.Text
Offer = Text6.Text
FactoryOffer = Text7.Text
Remark = Text8.Text
'---------------------------------------------------------------------
Dim FilePath As String
Dim FileInfo As String
Dim FileFullInfo As String
Open App.Path & "\SavePath.INI" For Input As #1 '获取设定好的文件保存路径
Input #1, FilePath
Close #1
FileInfo = n & ".xlsx"
FileFullInfo = FilePath + FileInfo
If Dir(FileFullInfo) = "" Then
MsgBox ("不存在")
Set excelApp = CreateObject("Excel.Application")
Set ExcelBook = excelApp.Workbooks.Add
Set ExcelSheet = ExcelBook.Worksheets(1)
ExcelSheet.Activate
excelApp.DisplayAlerts = False
ExcelSheet.Name = "sheet1"
ExcelBook.SaveAs FileName:=FileFullInfo
ExcelBook.Close
Set excelApp = Nothing
Set ExcelBook = Nothing
Set ExcelSheet = Nothing
'--------------------------------------------------------------
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(FileFullInfo)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Application.Visible = False
c = Sheets("sheet1").UsedRange.Rows.Count + 1
MsgBox (c)
xlSheet.Cells(1, 1) = "单号"
xlSheet.Cells(1, 2) = "类别"
xlSheet.Cells(1, 3) = "文件名"
xlSheet.Cells(1, 4) = "单文件要求"
xlSheet.Cells(1, 5) = "下单日期"
xlSheet.Cells(1, 6) = "客户"
xlSheet.Cells(1, 7) = "地址"
xlSheet.Cells(1, 8) = "联系方式"
xlSheet.Cells(1, 9) = "结款"
xlSheet.Cells(1, 10) = "运送方式"
xlSheet.Cells(1, 11) = "备注"
xlSheet.Cells(1, 12) = "下单员"
xlSheet.Cells(1, 13) = "报价"
xlSheet.Cells(1, 14) = "厂家报价"
xlSheet.Cells(c, 1) = c
xlSheet.Cells(c, 2) = Class
xlSheet.Cells(c, 3) = FileName
xlSheet.Cells(c, 4) = FileRequire
xlSheet.Cells(c, 5) = PartDate
xlSheet.Cells(c, 6) = Client
xlSheet.Cells(c, 7) = Address
xlSheet.Cells(c, 8) = Contact
xlSheet.Cells(c, 9) = Blance
xlSheet.Cells(c, 10) = Delivery
xlSheet.Cells(c, 11) = Remark
xlSheet.Cells(c, 12) = PartOrder
xlSheet.Cells(c, 13) = Offer
xlSheet.Cells(c, 14) = FactoryOffer
'----------------------------------------------------------------
xlBook.Save
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
Else
MsgBox ("存在")
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(FileFullInfo)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Application.Visible = False
c = Sheets("sheet1").UsedRange.Rows.Count + 1
xlSheet.Cells(1, 1) = "单号"
xlSheet.Cells(1, 2) = "类别"
xlSheet.Cells(1, 3) = "文件名"
xlSheet.Cells(1, 4) = "单文件要求"
xlSheet.Cells(1, 5) = "下单日期"
xlSheet.Cells(1, 6) = "客户"
xlSheet.Cells(1, 7) = "地址"
xlSheet.Cells(1, 8) = "联系方式"
xlSheet.Cells(1, 9) = "结款"
xlSheet.Cells(1, 10) = "运送方式"
xlSheet.Cells(1, 11) = "备注"
xlSheet.Cells(1, 12) = "下单员"
xlSheet.Cells(1, 13) = "报价"
xlSheet.Cells(1, 14) = "厂家报价"
xlSheet.Cells(c, 1) = c
xlSheet.Cells(c, 2) = Class
xlSheet.Cells(c, 3) = FileName
xlSheet.Cells(c, 4) = FileRequire
xlSheet.Cells(c, 5) = PartDate
xlSheet.Cells(c, 6) = Client
xlSheet.Cells(c, 7) = Address
xlSheet.Cells(c, 8) = Contact
xlSheet.Cells(c, 9) = Blance
xlSheet.Cells(c, 10) = Delivery
xlSheet.Cells(c, 11) = Remark
xlSheet.Cells(c, 12) = PartOrder
xlSheet.Cells(c, 13) = Offer
xlSheet.Cells(c, 14) = FactoryOffer
'----------------------------------------------------------------
xlBook.Save
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
End If
End Sub
Private Sub Timer1_Timer()
Label5.Caption = Now
y = Year(Date)
m = Month(Date)
d = Day(Date)
n = "意视印务" & y & "-" & m & "-" & d ’根据当天时间设定文件名
End Sub
