Excel VBA SaveAs 与 File SaveAs 有什么不同吗

问题描述 投票：0回答：3

这有点让人抓狂..

我有一个 Excel XLSM 工作簿，它从数据库下载数据，转换为会计系统的加载模板，创建日记帐模板并另存为应与加载过程兼容的 XLSX 文件。

加载过程抱怨“外部表不是预期的格式”

但是，如果我只是打开保存的文件然后重新保存，该文件将成功加载。

这表明 Excel VBA SaveAs 正在执行文件保存正在（或没有）执行的操作。

我尝试将 FileFormat 从 xlWorkbookDefault 更改为 xlOpenXMLWorkbook （相同的值），没有任何区别。

Excel版

适用于 Microsoft 365 MSO 的 Microsoft® Excel®（版本 2306 内部版本 16.0.16529.20100）64 位

VBA保存代码

Sub SaveJournalWorksheet()
    Dim saveDate As String
    Dim savePath As String
    saveDate = Format(Application.Range("reportDate"), "YYYYMMDD")
    shtJnl.Activate
    shtJnl.copy
    ActiveWorkbook.SaveAs Filename:="C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & saveDate, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    shtGroup.Activate
    shtGroup.copy
    ActiveWorkbook.SaveAs Filename:="C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & saveDate, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
End Sub
excel vba
3个回答
1
投票

尝试添加文件扩展名：例如-

Sub SaveJournalWorksheet()
    Const FLDR As String = "C:\Temp\Daily Journals\"
    Dim savePart As String
    
    'include the extension
    savePart = Format(Application.Range("reportDate"), "YYYYMMDD") & ".xlsx"
    
    SaveSheetToFile shtJnl, FLDR & "Daily_Sales_Journal_Combined_" & savePart
    SaveSheetToFile shtGroup, FLDR & "Daily_Sales_Journal_Group_" & savePart
End Sub

'copy `ws` as a new workbook, and save the new workbook to `savePath`
Sub SaveSheetToFile(ws As Worksheet, savePath As String)
    ws.Copy
    With ActiveWorkbook
        .SaveAs fileName:=savePath, FileFormat:=xlOpenXMLWorkbook
        .Close False
    End With
End Sub
1
投票

将工作表导出到新的
.xlsx
工作簿

  • 这仅在保存到 
    .xlsx
    文件时才有效。否则，请始终为 SaveAs 方法的 FileFormat 参数提供正确的文件扩展名和相应的参数。

紧凑（重复代码）

Sub SaveJournalWorksheet()
    
    Dim sDate: sDate = ThisWorkbook.Names("ReportDate").RefersToRange.Value
    
    If Not IsDate(sDate) Then
        MsgBox "The save date """ & CStr(sDate) & """ is invalid.", vbCritical
        Exit Sub
    End If
    
    Dim SaveDate As String: SaveDate = Format(sDate, "YYYYMMDD")
    
    Dim SavePath As String
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & SaveDate
    shtJnl.Copy
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=SavePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & SaveDate
    shtGroup.Copy
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=SavePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With

End Sub

使用辅助方法（子）-主方法（调用过程）

Sub SaveJournalWorksheetUsingMethod()
    
    Dim sDate: sDate = ThisWorkbook.Names("ReportDate").RefersToRange.Value
    
    If Not IsDate(sDate) Then
        MsgBox "The save date """ & CStr(sDate) & """ is invalid.", vbCritical
        Exit Sub
    End If
    
    Dim SaveDate As String: SaveDate = Format(sDate, "YYYYMMDD")
    
    Dim SavePath As String
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & SaveDate
    ExportSheetToXLSX shtJnl, SavePath
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & SaveDate
    ExportSheetToXLSX shtGroup, SavePath
    
End Sub

使用辅助方法（子）-方法

Sub ExportSheetToXLSX( _
        ByVal Sheet As Object, _
        ByVal FilePath As String)
    
    Sheet.Copy
    
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=FilePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With

End Sub
0
投票

子CreateVeluxPresentation() Dim pptApp 作为对象 将 pptPres 变暗为对象 Dim SlideIndex As Integer

' Kreiraj novu PowerPoint aplikaciju
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add

' Dodaj slajdove i sadržaj
slideIndex = 1

' 1. Naslovni slajd
With pptPres.Slides.Add(slideIndex, ppLayoutTitle)
    .Shapes(1).TextFrame.TextRange.Text = "VELUX"
    .Shapes(2).TextFrame.TextRange.Text = "Istorija, proizvodi i inovacije"
End With
slideIndex = slideIndex + 1

' 2. Uvod
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Uvod"
    .Shapes(2).TextFrame.TextRange.Text = "VELUX je globalni lider u proizvodnji krovnih prozora i rešenja za osvetljavanje."
End With
slideIndex = slideIndex + 1

' 3. Osnivanje kompanije
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Osnivanje"
    .Shapes(2).TextFrame.TextRange.Text = "Kompanija je osnovana 1941. godine u Danskoj."
End With
slideIndex = slideIndex + 1

' 4. Misija i vizija
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Misija i vizija"
    .Shapes(2).TextFrame.TextRange.Text = "Da poboljšamo kvalitet života ljudi kroz prirodno osvetljenje."
End With
slideIndex = slideIndex + 1

' 5. Proizvodi
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Proizvodi"
    .Shapes(2).TextFrame.TextRange.Text = "Krovni prozori, rolete, sistemi za ventilaciju i drugi proizvodi."
End With
slideIndex = slideIndex + 1

' 6. Tehnologija
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Tehnologija"
    .Shapes(2).TextFrame.TextRange.Text = "Inovacije u dizajnu i efikasnosti energije."
End With
slideIndex = slideIndex + 1

' 7. Ekološki pristup
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Ekološki pristup"
    .Shapes(2).TextFrame.TextRange.Text = "Održivost i ekološki prihvatljivi proizvodi."
End With
slideIndex = slideIndex + 1

' 8. Globalna prisutnost
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Globalna prisutnost"
    .Shapes(2).TextFrame.TextRange.Text = "Prodaja u više od 40 zemalja širom sveta."
End With
slideIndex = slideIndex + 1

' 9. Inovacije
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Inovacije"
    .Shapes(2).TextFrame.TextRange.Text = "Kontinuirani razvoj i unapređenje proizvoda."
End With
slideIndex = slideIndex + 1

' 10. Partnerstva
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Partnerstva"
    .Shapes(2).TextFrame.TextRange.Text = "Saradnja sa arhitektama i građevinskim firmama."
End With
slideIndex = slideIndex + 1

' 11. Brošure
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Brošure"
    .Shapes(2).TextFrame.TextRange.Text = "Pogledajte brošure za detaljnije informacije." & vbCrLf & "Link: https://www.velux.rs/podrska-kupcima/brosure"
End With
slideIndex = slideIndex + 1

' 12. Video sadržaj
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Video sadržaj"
    .Shapes(2).TextFrame.TextRange.Text = "Prikaz proizvoda i inovacija." & vbCrLf & "Link: https://www.youtube.com/watch?v=zV1HaL7kqj4"
End With
slideIndex = slideIndex + 1

' 13. Video 2
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Video 2"
    .Shapes(2).TextFrame.TextRange.Text = "Još jedan uvid u VELUX proizvode." & vbCrLf & "Link: https://www.youtube.com/watch?v=ZqnWtUNzkII"
End With
slideIndex = slideIndex + 1

' 14. Video 3
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Video 3"
    .Shapes(2).TextFrame.TextRange.Text = "Inovacije u akciji." & vbCrLf & "Link: https://www.youtube.com/watch?v=Z65pdmE53RA"
End With
slideIndex = slideIndex + 1

' 15. Video 4
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Video 4"
    .Shapes(2).TextFrame.TextRange.Text = "Dodatne informacije o proizvodima." & vbCrLf & "Link: https://www.youtube.com/watch?v=1EuiHYQXDXE"
End With
slideIndex = slideIndex + 1

' 16. Načini korišćenja
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Načini korišćenja"
    .Shapes(2).TextFrame.TextRange.Text = "Kako koristiti VELUX proizvode u vašem domu."
End With
slideIndex = slideIndex + 1

' 17. Reference
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Reference"
    .Shapes(2).TextFrame.TextRange.Text = "Korisni linkovi i literatura."
End With
slideIndex = slideIndex + 1

' 18. FAQ
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Česta pitanja"
    .Shapes(2).TextFrame.TextRange.Text = "Odgovori na najčešće postavljana pitanja."
End With
slideIndex = slideIndex + 1

' 19. Kontakt
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Kontakt"
    .Shapes(2).TextFrame.TextRange.Text = "Informacije o kontaktu i podršci."
End With
slideIndex = slideIndex + 1

' 20. Zaključak
With pptPres.Slides.Add(slideIndex, ppLayoutText)
    .Shapes(1).TextFrame.TextRange.Text = "Zaključak"
    .Shapes(2).TextFrame.TextRange.Text = "VELUX kao lider u inovacijama u osvetljavanju."
End With

' Čuvanje prezentacije
pptPres.SaveAs "C:\Users\TvojeKorisnickoIme\Documents\VeluxPresentation.pptx"

' Oslobodi resurse
Set pptPres = Nothing
Set pptApp = Nothing

结束子

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.