Fatal编程技术网
  • vba/
  • VBA错误6溢出宏

VBA错误6溢出宏

vba excel

VBA错误6溢出宏,vba,excel,Vba,Excel,直到几个月前我一直使用这个宏，但今天它不起作用了。 错误是由于这一部分，即 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 Di

直到几个月前我一直使用这个宏，但今天它不起作用了。 错误是由于这一部分，即

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
到

但行中的错误更改为1004：

ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
我不明白是什么？

一般来说，VBA中不应使用
整数。它比
Long
->

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


Dim i as long, j As long



关于第二个错误，请尝试将ValCell设置为字符串或提供有关其值的详细信息。
通常，VBA中不应使用整数。它比
Long
->

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


Dim i as long, j As long



关于第二个错误，请尝试
Dim ValCell as String
或提供有关其值的更多信息。
这样声明：
Dim i as long，j long
不回答，因为Vityata似乎手头有这个问题-但您在
页面设置中设置的所有值都不是必需的。大多数是默认值，无论如何都会设置为默认值。非常确定您只需要在整个块中有
.PrintArea=“$A$1:$P$”&CStr（j）
，其余部分可以删除。我删除了该块中的其余部分。同样的问题，第1004行错误“ValCell=Trim（CStr（FoglioElenco.Cells（j，1.Value））”声明如下：
Dim i as long，j as long
不回答，因为Vityata似乎手头有这个问题-但您在
页面设置中设置的所有值都不是必需的。大多数是默认值，无论如何都会设置为默认值。非常确定您只需要在整个块中有
.PrintArea=“$A$1:$P$”&CStr（j）
，其余部分可以删除。我删除了该块中的其余部分。同样的问题，第1004行出现错误“ValCell=Trim（CStr（FoglioElenco.Cells（j，1.Value））”我已经修改了您向我指示的内容Dim ValCell作为字符串“我有相同的错误：1004。取值为“ValCell=Trim（CStr（FoglioElenco.Cells（j，1.Value））”j=1048577@Razel-得到1004，因为excel行正好是1048576（2^20）。如果您想引用更多行，excel会提供1004-找不到对象。重写你的逻辑。奇怪的是，宏工作了两个月ago@Razel-您当时没有到达
2^20
。我已经修改了您向我指示的内容。”Dim ValCell作为字符串“我有相同的错误：1004。取值为“ValCell=Trim（CStr（FoglioElenco.Cells（j，1.Value））”j=1048577@Razel-得到1004，因为excel行正好是1048576（2^20）。如果您想引用更多行，excel会提供1004-找不到对象。重写你的逻辑。奇怪的是，宏工作了两个月ago@Razel-您当时没有到达
2^20
。

Dim i as long, j As long