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?更小、更慢

因此，将您的整数重新声明为long，溢出错误应得到修复：

Dim i as long, j As long

关于第二个错误，请尝试使用Dim ValCell as String或提供有关其值的更多信息。