VBA錯誤6溢出宏

Question

我一直使用這個宏，直到幾個月前，但今天它不起作用。 的錯誤是由於這部分，即

j = j + 1 

我怎樣才能解決這個問題？

這是代碼：

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" 
    '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 = "C:\ElencoCellEstrazione.xlsx" 
    PercorsoSalva = "C:\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:=xlOpenXMLWorkbookMacroEnabled, 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" 
End If 
End Sub 

我已經嘗試在該行中改變

Dim i, j As Integer 

到

Dim i As Integer, Dim j As Long 

但錯誤更改爲1004：

ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value)) 

是什麼讓我感到難過？

Answer 1

一般而言，Integer不應在VBA中使用。它體積更小，速度慢於Long - >Why Use Integer Instead of Long?

因此，重新聲明你的整數長，溢出錯誤應該是固定的：

Dim i as long, j As long 

關於第二個錯誤，請嘗試Dim ValCell as String或提供有關其價值的詳細信息。