Ошибка в Microsoft Visual Basic

Gatya · Повідомлення 03.06.2014 17:30

Камрад SoulOfONYX попросил запостить:

Приветствую всех форумчан, нужна помощь кто шарит в VBA. на работе скинули файлик *.xls с макросами. Суть файла - я его правлю как мне надо, затем нажимаю кнопку "создать файл для клиентов" - и по идее он должен создать другой файл с учетом правок. Но по факту получаю ошибку:

Код: Виділити все

Run-time error 9: subscript out of range

при нажатии debug выделяет строчку

Код: Виділити все

Windows("WN").Activate

Прошу помощи побороть данную траблу и править код что бы файлик заработал. drinks.gif Весь код скрипта под спойлером

спойлер

Код: Виділити все

Private Sub CommandButton1_Click()
'   Файл для клиентов
    Dim y, m, d As Integer
    Dim A, B, Dat As String
    Dim WB, WN As String
    Dim i, n, V As Integer
    For i = 4 To 10000
        If IsError(ActiveSheet.Range("T" & i).Value) Then
            ActiveSheet.Range("T" & i).Select
            MsgBox ("Не все эмитенты учтены на странице ""Выборка""")
            GoTo Oshibka
        End If
        If (ActiveSheet.Range("T" & i).Value < 0 And ActiveSheet.Range("T" & i).Value > 10) Then
            If ActiveSheet.Range("D" & i).Value = "" Then GoTo Nni
            ActiveSheet.Range("T" & i).Select
            MsgBox ("В столбце учёта неточные данные (В списке)")
            GoTo Oshibka
        End If
    Next i
Nni:
    B = ActiveSheet.Range("V2")               'Диапазон / дата файла
    y = Year(B)
    m = Month(B)
    d = Day(B)
    Dat = y
    If m < 10 Then A = "0" & m
    If m > 9 Then A = m
    Dat = Dat & "-" & A
    If d < 10 Then A = "0" & d
    If d > 9 Then A = d
    Dat = Dat & "-" & A
    B = ActiveSheet.Range("V3")               'Диапазон / название файла
    WN = Dat & " - " & B
    WB = ActiveWorkbook.Name
'   Создание файла
    A = Worksheets("Выборка").Range("E2").Value               'Диапазон / путь сохранения
    Workbooks.Add (1)
    ActiveWorkbook.SaveAs Filename:=A & WN & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
'   Копирование данных
    Application.CutCopyMode = False
    Windows(WB).Activate
    n = 4
    For i = 4 To 10000
        A = "D" & i
        If ActiveSheet.Range(A).Value = "" Then GoTo Nnn
        n = i
    Next i
Nnn:
'   Выбор диапозона
    ActiveSheet.Columns("A:U").Select               'Диапазон
    Selection.Copy
    Windows("WN").Activate
    ActiveSheet.Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("C4:C" & n).Copy
    ActiveSheet.Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    ActiveSheet.Rows("1:1").Delete
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
    ActiveSheet.Columns("A:Q").Ungroup               'Диапазон
'   Проверка включения в сеть
    V = n
    For i = 3 To V
Zzz:
        If ActiveSheet.Range("U" & i).Value = 1 Then               'Диапазон
            V = V + 1
            If V > n Then GoTo Sqd
            GoTo Zzz
        End If
        ActiveSheet.Rows(i & ":" & i).Delete Shift:=xlUp
        V = V - 1
        GoTo Zzz:
    Next i
Sqd:
'   Количество строк
    For i = 3 To 10000
        If ActiveSheet.Range("D" & i).Value = "" Then GoTo Kkk
        n = i
    Next i
Kkk:
    ActiveSheet.Range("A1:Q" & n).FormatConditions.Delete
    ActiveSheet.Range("A3:B3").Copy
    ActiveSheet.Range("A4:A" & n).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("A3").Select
'   Удаление ненужных столбцов
    ActiveSheet.Columns("R:U").Delete               'Диапазон
'   Разделение по областям / регионам
    For i = 3 To n
        If ActiveSheet.Range("D" & i).Value <> ActiveSheet.Range("D" & (i + 1)).Value Then
            ActiveSheet.Range("A" & i & ":Q" & i).Borders(xlEdgeBottom).Weight = xlThick
        End If
        If ActiveSheet.Range("E" & i).Value = "Vesta" Then ActiveSheet.Range("A" & i & ":Q" & i).Font.Bold = True
'   Нумерация строк
        ActiveSheet.Range("A" & i).FormulaR1C1 = "=IF(RC[3]="""","""",IF(TYPE(R[-1]C)=1,R[-1]C+1,1))"
        ActiveSheet.Range("B" & i).FormulaR1C1 = "=IF(RC[2]="""","""",IF(RC[2]=R[-1]C[2],R[-1]C+1,1))"
    Next i
'   Выставление параметров страницы
    ActiveSheet.Range("A3").Select
    ActiveWindow.FreezePanes = True
    ActiveSheet.Name = "ТОВ ""ЛОТОС-ЕНЕРГІЯ"""
    ActiveSheet.Range("A1").Select
    ActiveWindow.Zoom = 85               'Диапазон
    A = "$A$2:$Q$" & n
    ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(1.18110236220472)
    ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.PrintArea = A
    ActiveSheet.PageSetup.LeftHeader = "&""Arial,полужирный""&14" & Chr(10) & "" & Chr(10) & _
        "Список АЗС для заправки автотранспорту за" & Chr(10) & _
        "СМАРТ-КАРТАМИ ТОВ ""ЛОТОС-ЕНЕРГІЯ"" на " & _
        Mid(Dat, 9, 2) & "." & Mid(Dat, 6, 2) & "." & Mid(Dat, 1, 4) _
        & "&""Arial,полужирный""&11" & _
        Chr(10) & "" & Chr(10) & "сторінка &P з &N"
    ActiveSheet.PageSetup.RightHeaderPicture.Filename = _
        "E:\Список АЗС Lotos\lotos.jpg"
    ActiveSheet.PageSetup.RightHeaderPicture.Height = 65.25
    ActiveSheet.PageSetup.RightHeaderPicture.Width = 200.25
    ActiveSheet.PageSetup.RightHeader = "&G"
    ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
    ActiveSheet.PageSetup.Zoom = False
    ActiveSheet.PageSetup.FitToPagesWide = 1
    ActiveSheet.PageSetup.FitToPagesTall = 500
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Windows(WB).Activate
    ActiveWorkbook.ActiveSheet.Range("D4").Activate
Oshibka:
End Sub

Private Sub CommandButton2_Click()
'   Сортировка
    Dim A, B As String
    Dim i As Integer
    Dim n As Long
    A = "D4"               'Диапазон
    B = "R4"               'Диапазон
    n = 50000               'Диапазон
    ActiveSheet.Range("C4:Q" & n).Select               'Диапазон
    Selection.Sort Key1:=Range(A), Order1:=xlAscending, Key2:=Range(B) _
        , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
    ActiveSheet.Range("D4").Select
End Sub

Private Sub CommandButton3_Click()
'   Файл для горячей линии
    Dim y, m, d As Integer
    Dim A, B, Dat As String
    Dim WB, WN As String
    Dim i, n, V As Integer
    For i = 4 To 10000
        If IsError(ActiveSheet.Range("U" & i).Value) Then
            ActiveSheet.Range("U" & i).Select
            MsgBox ("Не все эмитенты учтены на странице ""Выборка""")
            GoTo Oshibka
        End If
        If (ActiveSheet.Range("U" & i).Value < 0 And ActiveSheet.Range("S" & i).Value > 10) Then
            If ActiveSheet.Range("D" & i).Value = "" Then GoTo Nni
            ActiveSheet.Range("U" & i).Select
            MsgBox ("В столбце учёта неточные данные (В списке)")
            GoTo Oshibka
        End If
    Next i
Nni:
    B = ActiveSheet.Range("V2")               'Диапазон / дата файла
    y = Year(B)
    m = Month(B)
    d = Day(B)
    Dat = y
    If m < 10 Then A = "0" & m
    If m > 9 Then A = m
    Dat = Dat & "-" & A
    If d < 10 Then A = "0" & d
    If d > 9 Then A = d
    Dat = Dat & "-" & A
    B = ActiveSheet.Range("V3") & " - Горячая линия"               'Диапазон / название файла
    WN = Dat & " - " & B
    WB = ActiveWorkbook.Name
'   Создание файла
    A = Worksheets("Выборка").Range("E2").Value               'Диапазон / путь сохранения
    Workbooks.Add (1)
    ActiveWorkbook.SaveAs Filename:=A & WN & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
'   Копирование данных
    Application.CutCopyMode = False
    Windows(WB).Activate
    n = 4
    For i = 4 To 10000
        A = "D" & i
        If ActiveSheet.Range(A).Value = "" Then GoTo Nnn
        n = i
    Next i
Nnn:
'   Выбор диапозона
    ActiveSheet.Columns("A:U").Select               'Диапазон
    Selection.Copy
    Windows(WB).Activate
    ActiveSheet.Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("C4:C" & n).Copy
    ActiveSheet.Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    ActiveSheet.Rows("1:1").Delete
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
    ActiveSheet.Columns("A:R").Ungroup               'Диапазон
'   Проверка включения в сеть
    V = n
    For i = 3 To V
Zzz:
        If ActiveSheet.Range("U" & i).Value = 0 Then               'Диапазон / удаление строк
            ActiveSheet.Rows(i & ":" & i).Delete Shift:=xlUp
            V = V - 1
            GoTo Zzz:
        End If
    Next i
'   Количество строк
    For i = 3 To 10000
        If ActiveSheet.Range("D" & i).Value = "" Then GoTo Kkk
        n = i
    Next i
Kkk:
    ActiveSheet.Range("A1:O" & n).FormatConditions.Delete
    ActiveSheet.Range("A3:B3").Copy
    ActiveSheet.Range("A4:A" & n).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("A3").Select
'   Удаление ненужных столбцов
    ActiveSheet.Columns("S:U").Delete               'Диапазон
'   Разделение по областям / регионам
    For i = 3 To n
        If ActiveSheet.Range("D" & i).Value <> ActiveSheet.Range("D" & (i + 1)).Value Then
            ActiveSheet.Range("A" & i & ":O" & i).Borders(xlEdgeBottom).Weight = xlThick
        End If
        If ActiveSheet.Range("E" & i).Value = "Vesta" Then ActiveSheet.Range("A" & i & ":O" & i).Font.Bold = True
'   Нумерация строк
        ActiveSheet.Range("A" & i).FormulaR1C1 = "=IF(RC[3]="""","""",IF(TYPE(R[-1]C)=1,R[-1]C+1,1))"
        ActiveSheet.Range("B" & i).FormulaR1C1 = "=IF(RC[2]="""","""",IF(RC[2]=R[-1]C[2],R[-1]C+1,1))"
    Next i
'   Выставление параметров страницы
    ActiveSheet.Range("A3").Select
    ActiveWindow.FreezePanes = True
    ActiveSheet.Name = "ТОВ ""Веста Сервіс"""
    ActiveSheet.Range("A1").Select
    ActiveWindow.Zoom = 85               'Диапазон
    A = "$A$2:$R$" & n
    ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(1.18110236220472)
    ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0)
    ActiveSheet.PageSetup.PrintArea = A
    ActiveSheet.PageSetup.LeftHeader = "&""Arial,полужирный""&14" & Chr(10) & "" & Chr(10) & _
        "Список АЗС для заправки автотранспорту за" & Chr(10) & _
        "СМАРТ-КАРТАМИ ТОВ ""Веста Сервіс"" на " & _
        Mid(Dat, 9, 2) & "." & Mid(Dat, 6, 2) & "." & Mid(Dat, 1, 4) _
        & "&""Arial,полужирный""&11" & _
        Chr(10) & "" & Chr(10) & "сторінка &P з &N"
    ActiveSheet.PageSetup.RightHeaderPicture.Filename = _
        "E:\Список АЗС Lotos\lotos.jpg"
    ActiveSheet.PageSetup.RightHeaderPicture.Height = 65.25
    ActiveSheet.PageSetup.RightHeaderPicture.Width = 200.25
    ActiveSheet.PageSetup.RightHeader = "&G"
    ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
    ActiveSheet.PageSetup.Zoom = False
    ActiveSheet.PageSetup.FitToPagesWide = 1
    ActiveSheet.PageSetup.FitToPagesTall = 500
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Windows(WB).Activate
    ActiveWorkbook.ActiveSheet.Range("D4").Activate
Oshibka:
End Sub

Если кто-то знает решение или возникнут вопросы - пишите в теме, он ответит

vegas.pl.ua · Повідомлення 03.06.2014 17:56

Gatya:Камрад SoulOfONYX попросил запостить:
при нажатии debug выделяет строчку
Код: Виділити все
Windows("WN").Activate
Если кто-то знает решение или возникнут вопросы - пишите в теме, он ответит

Немає такого вікна із назвою "WN".
Потрібно так

Код: Виділити все

Windows(WN).Activate

SoulOfONYX · Повідомлення 04.06.2014 11:16

vegas.pl.ua
видел я это, убрать скобки - не помогло, но изменив WN на WB excel выдает всплывающее окно "Заменить содержимое конечных ячеек?" При ответе да - формирует данные но не в новый файл как полагается,а в таблицу которую я редактировал.

moff · Повідомлення 04.06.2014 11:41

Возможно надо добавить в переменную WN расширение ".xls" либо другое или проверить наличие такого файла открытым.
код для проверки открытых файлов

Код: Виділити все

For Each ww In Workbooks
    MsgBox ww.Name
Next