標題: 請問如何將產生xls檔改成產生xlsm檔 [打印本頁]

---

作者: twosix    時間: 2014-8-2 14:57     標題: 請問如何將產生xls檔改成產生xlsm檔

下面是我寫來將txt檔資料轉成xls檔
可是我把下面紅色的地方改成xlsm時就會不能跑
想請問該怎麼改才可以變成轉換xlsm檔
謝謝~

Sub Main()
    wk_name = ActiveWorkbook.Name
   
    Application.Calculation = xlCalculationAutomatic   '設定自動計算
   
    Windows(wk_name).Activate
    Sheets("Main").Select
    count910_num = Cells(1, 7)   '商品總數
    Cells(3, 2) = 1              '從第一個商品開始跑
   
    For I = 1 To count910_num
   
    Windows(wk_name).Activate
    Sheets("Main").Select
    Cells(3, 2) = I
    intput_path910 = Cells(4, 3)   '910檔案存放位址
    val_date = Cells(6, 3)         '評價日
    pol_name = Cells(7, 3)         '商品代碼
   
    Call openGR910 '叫出下面的程式
   
    Next I
   
    j = 1
    Do

    Windows(wk_name).Activate
    Sheets("Main").Select
    Cells(3, 2) = j
    intput_path912 = Cells(5, 3)     '912檔案存放位址
    val_date = Cells(6, 3)
    pol_name = Cells(7, 3)
   
    Call openGR912
   
    j = j + 1
    Loop While pol_name <> "64"    '只有算到"64"這個險種，如果之後還有增加要再做修改


End Sub

Sub openGR910()

    intput_path910 = Cells(4, 3)
    intput_path912 = Cells(5, 3)
    val_date = Cells(6, 3)
    pol_name = Cells(7, 3)
   
    '讀取TXT檔的數據
    ChDir intput_path910
    Workbooks.OpenText Filename:=intput_path910 & "GR910_" & pol_name & "_" & val_date & ".txt", _
        Origin:=950, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 2), Array(12, 2), Array(17, 2), Array(25, 2), Array(34, 2), Array(39, 2), Array(44 _
        , 2), Array(55, 2), Array(72, 2), Array(77, 2), Array(84, 1), Array(97, 2), Array(106, 1), _
        Array(117, 1), Array(129, 1), Array(144, 1)), TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWindow.Zoom = 70
    Range("A4").Select
    ActiveWindow.FreezePanes = True
    Application.DisplayAlerts = False      '不要顯示關閉視窗
    '在以下位址存放檔案(檔名.xls)
    ActiveWorkbook.SaveAs Filename:=intput_path910 & "GR910_" & pol_name & ".xls" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
    ActiveWorkbook.Close
   
End Sub

Sub openGR912()
    Dim check_num As Long
   
    intput_path910 = Cells(4, 3)
    intput_path912 = Cells(5, 3)
    val_date = Cells(6, 3)
    pol_name = Cells(7, 3)
        
    ChDir intput_path912
    Workbooks.OpenText Filename:=intput_path912 & "GR912_" & pol_name & ".txt", _
        Origin:=950, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
        Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 2), _
        Array(9, 1), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWindow.Zoom = 80
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=intput_path912 & "GR912_" & pol_name & ".xls", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
    ActiveWorkbook.Save
    ActiveWorkbook.Close
      
End Sub

---

作者: stillfish00    時間: 2014-8-2 18:28

回復 1# twosix

ActiveWorkbook.SaveAs Filename:=intput_path910 & "GR910_" & pol_name & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)