台灣最大程式設計社群網站
線上人數
1095
 
會員總數:246274
討論主題:189809
歡迎您免費加入會員
討論區列表 >> VB6 >> xls轉csv問題請教
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
xls轉csv問題請教
價值 : 10 QP  點閱數:2472 回應數:0
樓主

帥道昏倒
門外漢
0 2
74 2
發送站內信

各位大大您好!!
我在xls轉csv時有個問題,
若xls檔案內A1為-4081.77(儲存格格式為數字-會計專用)
我在轉成csv檔後,發現內容為(4,081.77)
以不改xls檔案,但csv檔要出現-4,081.77,不知如何設定下列程式
我本想指定遇到數值IsNumeric時,則改格式為"##0.00",
但若遇到其他檔案需出現-40.789(小數3位)或是50.1234(小數4位),
那我就不能去指定格式了
ps.想與excel另存新檔(存成csv檔)後的檔案一致,
用excel存成csv時,是出現-4,081.77
用xlsheet.SaveAs filename, xlCSV 卻是出現(4,081.77)

------------------------------
Text1 ------------TextBox-----xls檔案目錄( C:\test\ )
Text2 ------------TextBox-----csv保存目錄( C:\test\ )
xls2csv ------------Button
-------------------------------------------------------------------------
Private Sub xls2csv_Click()
Dim xlapp As Excel.Application 'Excel對象
Dim xlbook As Excel.Workbook '工作簿
Dim xlsheet As Excel.Worksheet '工作表
Dim filename As String, cdir As String, cdir2 As String
Dim s1 As Integer
Dim i, j, k, n As Integer
Dim mTop, mLeft, mRight, mButtom
Dim msg As String
Set fs = CreateObject("Scripting.FileSystemObject")
If Text1.Text = "" Then
MsgBox "xls檔案目錄不可為空白!請重新輸入 "
Exit Sub
End If
cdir = Text1.Text
If fs.FolderExists(cdir) = True Then '判斷目錄是不存在
'MsgBox ("xls檔案目錄設置為" & cdir)
Else
MsgBox "xls檔案目錄" & cdir & "不存在!請重新輸入 "
Exit Sub
End If

Set xlapp = CreateObject("Excel.Application") '創建EXCEL對象
Set inp = fs.GetFolder(cdir)
Set fileList = inp.Files

For Each f In fileList
Fname = f.Name
If Right(Fname, 3) = "xls" Then
Set xlbook = xlapp.Workbooks.Open(cdir & Fname) '打開已經存在的工件簿文件
xlapp.Visible = False '設置EXCEL對象可見(或不可見)
s1 = xlbook.Worksheets.Count '讀取sheet個數

For k = 1 To s1
Set xlsheet = xlbook.Worksheets(k) '設置活動工作表
mTop = xlsheet.UsedRange.Cells.Rows.Count '最終行
mLeft = xlsheet.UsedRange.Cells.Columns.Count '最終列
If mTop <> 1 And mLeft <> 1 Then
For i = 1 To mTop + 3 '行1234
For j = 1 To mLeft + 3 '列ABCD
If Information.IsDate(xlsheet.Cells(i, j)) = True Then
xlsheet.Cells(i, j).NumberFormat = "yyyy/m/d"
End If
Next j
Next i
filename = Text2.Text & Replace(Fname, ".xls", "") & "(" & k & ")" & ".csv"
xlsheet.SaveAs filename, xlCSV '將sheet存檔為csv格式
End If 'mTop <> 1 And mLeft <> 1
Next k
xlbook.Close (SaveChanges = -1)
End If 'Right(Fname, 3) = "xls"
Next
Set xlapp = Nothing '釋放xlApp對象
End Sub

本篇文章發表於2010-08-25 10:06
目前尚無任何回覆
   

回覆
如要回應,請先登入.