这样修改代码保存XLSX文件

yaozhaoze

请各位老师帮忙
   我用EXCEL XLS文件运行以下代码，现在是保存EXCEL XLS文件，我想修改运行以下代码保存EXCEL XLSX文件，（ .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xls", 18）我尝试修改（ .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xlsx", 18好像不可以）请各位老师帮忙修改，谢谢

   ActiveWorkbook.Save
    Application.ScreenUpdating = True
        Dim Arr, i&, wb As Workbook, nm1$
Dim d, k, t, j&, aa
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set wb = ThisWorkbook
Sheet1.Activate
Arr = [a1].CurrentRegion
For i = 2 To UBound(Arr)
    d(Arr(i, 6)) = d(Arr(i, 6)) & i & ","
Next
k = d.keys: t = d.items
For i = 0 To UBound(k)
    nm1 = k(i)
    Workbooks.Add
    With ActiveWorkbook
        With .Sheets(1)
            .Cells.NumberFormatLocal = "@"
            .Select
            .[a1].Resize(1, UBound(Arr, 2)) = Application.Index(Arr, 1, 0)
            t(i) = Left(t(i), Len(t(i)) - 1)
            If InStr(t(i), ",") Then
                aa = Split(t(i), ",")
                For j = 0 To UBound(aa)
                    .Cells(j + 2, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, aa(j), 0)
                Next
            Else
                .Cells(j + 2, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, t(i), 0)
            End If
            .Cells.EntireColumn.AutoFit
        End With
        .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xls", 18
        .Close
         j = 0
    End With
Next
End Sub

chaohuahch

.SaveAs ThisWorkbook.Path & "\" & nm1 & ".xls", 18 修改成  .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xls" 试一试。

yaozhaoze

.SaveAs ThisWorkbook.Path & "\" & nm1 & ".xls", 18 修改成  .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xlsx" 这样可以了，谢谢您老师，这个为什么，可以解释一下吗

lsc900707

你当前使用的office版本是哪个？如果是2007及以上版本，直接  .SaveAs ThisWorkbook.Path & "\" & nm1

lsc900707

建议楼主上传附件看看。

yaozhaoze

您看看这个
VBA代码 哪错了运行错误，请老师帮忙
http://club.excelhome.net/thread-1426774-1-1.html