我对Excel宏有一些问题......
当我运行此脚本时，我收到了
错误运行时1004：方法保存为对象_workbook失败
一个月前，这个宏工作得很好......问题在哪里？
我没有做这个剧本的程序，我发现它已经在我的老同事的车站使用了，到目前为止一直没有给出任何问题....
感谢您的帮助
Sub StampaVodafone()
Dim i, j As Integer
Dim Fogliotmp As Worksheet
Dim ContoVodafone As String
Dim FoglioElenco As Worksheet
Dim Percorsofile As String
Dim PercorsoSalva As String
Dim ValCell As Variant
Dim strTesto As String
strTesto = "Vuoi procedere con la stampa ?" & vbCr & "SI - Per procedere con la stampa dei dettagli telefonici" & _
vbCr & "NO - Per andare alla procedura successiva"
If MsgBox(strTesto, 68, "Avvio StampaVodafone") = vbYes Then
'Procedura di stampa documenti
i = 1
Do
Set Fogliotmp = ActiveWorkbook.Worksheets(i)
If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Or UCase(Mid(Fogliotmp.Name, 1, 3)) = "LA " Then
'Trovo dove sta la fine pagina
j = 15
ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
Do While (UCase(ValCell) <> "TOTALE COSTI")
j = j + 1
ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
Loop
With Fogliotmp.PageSetup
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 0
.PrintArea = "$A$1:$P$" & CStr(j)
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Fogliotmp.PrintOut
End If
i = i + 1
Set Fogliotmp = Nothing
Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
MsgBox "Ho terminato di stampare", vbExclamation, "MACRO SONIA"
'Fine procedura stampa
End If
'--
strTesto = "Vuoi procedere con l'estrazione dei file XLSX da spedire agli utenti?" & vbCr & _
"SI - Inizia la generazione dei file XLSX" & vbCr & _
"NO - Termina la macro"
If MsgBox(strTesto, 68, "Genera XLS") = vbYes Then
'Inizio estrazione
Percorsofile = "H:\Vodafone\ElencoCellEstrazione.xlsx"
PercorsoSalva = "H:\Vodafone\Estratti\"
ContoVodafone = Application.ActiveWorkbook.Name
'--
Set FoglioElenco = Workbooks.Open(Percorsofile).Worksheets(1)
'--
i = 1
Do
Windows(ContoVodafone).Activate
Set Fogliotmp = ActiveWorkbook.Worksheets(i)
If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Then
strTesto = Trim(Mid(Fogliotmp.Name, 4, Len(Fogliotmp.Name)))
'Cerco il nome della persona
j = 2
ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
Do While (UCase(ValCell) <> UCase(strTesto) And UCase(ValCell) <> "END LIST")
j = j + 1
ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
Loop
If UCase(ValCell) <> "END LIST" Then
'Ho il nome dell'intestatario del telefono
ValCell = Trim(CStr(FoglioElenco.Cells(j, 2).Value))
strTesto = PercorsoSalva & ValCell
'Salvo il documento
Windows(ContoVodafone).Activate
Sheets(Fogliotmp.Name).Select
Sheets(Fogliotmp.Name).Copy
ActiveWorkbook.SaveAs Filename:=strTesto, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Windows(ContoVodafone).Activate
End If
End If
'--
i = i + 1
Set Fogliotmp = Nothing
Windows(ContoVodafone).Activate
Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
MsgBox "Ho terminato gli export XlsX", vbExclamation, "MACRO SONIA"
End If
End Sub