SAPфорум.RU https://sapboard.ru/forum/ |
|
Слетел макрос в рабочей книге BW https://sapboard.ru/forum/viewtopic.php?f=12&t=96964 |
Страница 1 из 1 |
Автор: | fifty [ Вт, окт 16 2018, 16:48 ] |
Заголовок сообщения: | Слетел макрос в рабочей книге BW |
Здравствуйте, есть отчет, рабочая книга с макросом, не известно по какой причине перестал работать. При запуске выбрасывает следующая ошибка в VBA: Compile error Variable not defined и выделяется Setup из следующего фрагмента: If queryID = svodID Then ' Вставка от 13.03.2012 Запись рассчитанного значения Области результатов в ячейку А6 листа Настройка ' Worksheets("Настройка").Range("a1").Value = resultArea.Address Setup.Range("A6").Value = resultArea.Address ' Конец вставки от 13.03.2012 Пятов М. 'Set MainResult = resultArea End If Подскажите пожалуйста, какие есть решения для возврата работоспособности отчета? Из ошибки понимаю, что переменная не определена. но что из себя представляет Setup? |
Автор: | Air_demon [ Вт, окт 16 2018, 17:41 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Добрый день. Не видя самой книги можно только предполагать "что в черном ящике". Мое предположение, что это техническое имя настроечного листа. |
Автор: | Kavaii [ Чт, окт 18 2018, 12:12 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Без всего текста макроса тяжело судить, что слетело + хорошо бы увидеть книгу, хотя бы диспетчер имён. |
Автор: | fifty [ Пт, окт 19 2018, 12:15 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Добрый день, спасибо за ответы. А как посмотреть диспетчер имен в рабочей книге? Ниже весь макрос: Option Explicit Const ER = 16000 Public MainResult As Range Public detailRESULT As Range Public AreaForSearch As Range Public BE_Arr() As Variant 'Public fso As Variant, ts As Variant Public rRang As Range Public CR_ As String Sub SAPBEXonRefresh(queryID As String, resultArea As Range) Dim IDf4 As String, svodID As String, detailID As String Dim kol_be As Long, iNum As Long 'Dim vFileName As String Dim i As Long Dim Prn As String With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Calculation = xlCalculationAutomatic End With ' CR_ = Chr(13) & Chr(10) ' Set fso = CreateObject("Scripting.FileSystemobject") ' vFileName = "C:\1\" & queryID & ".prt" ' Set ts = fso.CreateTextFile(vFileName, True) ' ts.Write "Протокол формирования отчета" & CR_ ' ts.Write "Начало формирования: " & Date & " " & Time & CR_ & CR_ IDf4 = SAPBEXqueries.Range("F4:F4").Value 'Worksheets("Print").Range("A1:A1").Value = queryID 'Worksheets("Print").Range("A2:A2").Value = IDf4 For i = 1 To 20 ' ID запросов, которые использовались до перехода на мультиотчёты (Комментарий от Пятова Михаила 13.03.2012) If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "4HJMIDCTM689GFB0IRP6DDKWY" Then svodID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "4HJMIWCGHPWCI5DYY3HJ88EN6" Then detailID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If ' Вставка 13.03.2012 Пятов Михаил ' Для корректной отработки макроса для разных иерархий необходимо учитывать, ' что ID запросов изменились, поиск выше результатов не давал, поэтому листы по филиалам (например: ГО, УР и тп) ' не заполнялись значениями с листа Detail. Нужно это учитывать. ' Технические ID запросов, включённых в раб.книгу можно найти на листе SAPBEXqueries, в свойстах сделав его видимым ' (Комментарий от Пятова Михаила 13.03.2012) If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "4LF1NXZADTT7ZR8Z8LUQZCXLU" Then svodID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "4LF1NZWF4H8LNE40P4FTHUM1U" Then detailID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If ' Конец вставки от 13.03.2012 ' Вставка 27.11.2012 If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "007VOYF1MNZVW8WIV948EML1C" Then svodID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If If SAPBEXqueries.Range("C" + Trim(Str(i)) + ":C" + Trim(Str(i))).Value = "007VOYF1MNZXMJARA0IGYAKG6" Then detailID = SAPBEXqueries.Range("F" + Trim(Str(i)) + ":F" + Trim(Str(i))).Value End If Next If queryID = svodID Then ' Вставка от 13.03.2012 Запись рассчитанного значения Области результатов в ячейку А6 листа Настройка ' Worksheets("Настройка").Range("a1").Value = resultArea.Address Setup.Range("A6").Value = resultArea.Address ' Конец вставки от 13.03.2012 Пятов М. 'Set MainResult = resultArea End If If queryID = detailID Then ' Вставка от 13.03.2012 Запись рассчитанного значения Области результатов в ячейку А7 листа Настройка 'Worksheets("Настройка").Range("a2").Value = resultArea.Address Setup.Range("A7").Value = resultArea.Address ' Конец вставки от 13.03.2012 Пятов М. 'Set detailRESULT = resultArea End If 'MsgBox resultArea.Address ' Вставка от 17.05.2012 НР ' Заполнение массива БЕ iNum = 1 kol_be = 0 Do While Setup.Cells(iNum, 14).Value <> "" kol_be = kol_be + 1 ReDim Preserve BE_Arr(1 To 4, 1 To kol_be) As Variant BE_Arr(1, kol_be) = Setup.Cells(iNum, 14).Value BE_Arr(2, kol_be) = Setup.Cells(iNum, 15).Value BE_Arr(3, kol_be) = Setup.Cells(iNum, 16).Value BE_Arr(4, kol_be) = Setup.Cells(iNum, 17).Value iNum = iNum + 1 Loop ' Окончание вставки от 17.05.2012 НР If queryID = IDf4 Then Prn = "2" Sheets(Prn).Select Call GlobalFormattingVer01 ' Call Clear("Main", 17) Call Del_Col("Main", 5) Call Clear("Detail", 17) End If ' ts.Write "Окончание формирования: " & Date & " " & Time ' ts.Close ' Set ts = Nothing ' Set fso = Nothing With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub Sub GlobalFormattingVer01() Dim i As Long, k As Long, iFound As Long, iNum As Long, iCount As Long Dim BE_Name As String Dim wShape As Shape Dim wSheet As Worksheet Dim lLastRow As Long, lLastCol As Long Dim MainAddress As String, DetailAddress As String Dim NODataAREArows As Long, RowCnt As Long Dim Sourse As String, BECell As String Dim yOffset As Long, x1 As Long, y1 As Long, x1svod As Long Dim StrADDRess As String Dim vRange As Variant ' ts.Write "GlobalFormattingVer01: " & Date & " " & Time & CR_ & CR_ 'Application.ScreenUpdating = False ' Вставка 13.03.2012 Пятов Михаил ' Считывание значений диапазонов областей результатов из вставленных в лист Настройки значений A6 и A7 ' MainAddress = Worksheets("Настройка").Range("a1").Value ' DetailAddress = Worksheets("Настройка").Range("a2").Value MainAddress = Setup.Range("A6").Value DetailAddress = Setup.Range("A7").Value ' Окончание вставки от 13.03.2012 Пятов М. Worksheets("Main").Activate Set MainResult = Worksheets("Main").Range(MainAddress) Worksheets("Detail").Activate Set detailRESULT = Worksheets("Detail").Range(DetailAddress) NODataAREArows = 2 RowCnt = MainResult.Rows.Count - NODataAREArows Sourse = "Detail" yOffset = 5 y1 = detailRESULT.Columns.Count + detailRESULT.Column - 1 x1 = detailRESULT.Row + NODataAREArows x1svod = MainResult.Row + NODataAREArows Worksheets(Sourse).Activate BECell = Worksheets(Sourse).Cells(x1, 1).Value 'Clear all target sheets ' Закомментарил 17.05.2012 НР 'Clear "УР" 'Clear "АТ" 'Clear "АК" 'Clear "КОС" 'Clear "ЮЖ" 'Clear "ШЫМ" 'Clear "АГП ШЫМ" 'Clear "АГП" 'Clear "УП" 'Clear "КО" 'Clear "АКТАУ" 'Clear "ТАРАЗ" 'Clear "УКК" 'Clear "АГП ТАРАЗ" 'Clear "УАВРиСТ" 'Clear "АГП УАВРиСТ" 'Clear "ББШ Актобе" 'Clear "ББШ Южный" 'Clear "ББШ Кызылорда" 'Clear "ББШ Актау" 'Clear "ББШ УАВРиСТ" 'Clear "ББШ Костанай" 'Clear "ББШ Шымкент" ' Окончание закомментаренного куска от 17.05.2012 НР Call Clear("2", 14) Call Clear("Свод", 14) ' Вставка от 17.05.2012 НР Call Clear("ГО", 14) ' Application.DisplayAlerts = False With ActiveWorkbook iCount = .Sheets.Count i = 1 Do While i <= iCount iFound = 0 For k = LBound(BE_Arr, 2) To UBound(BE_Arr, 2) If Sheets.Item(i).Name = BE_Arr(2, k) And BE_Arr(3, k) = 0 Then iFound = k Exit For End If Next k If iFound > 0 Then Sheets(i).Select ActiveWindow.SelectedSheets.Delete iCount = .Sheets.Count Else i = i + 1 End If Loop End With ' Application.DisplayAlerts = True iNum = 0 With ActiveWorkbook For i = 1 To .Sheets.Count If Sheets.Item(i).Name = "ГО" Then iNum = i Exit For End If Next i End With For k = UBound(BE_Arr, 2) To LBound(BE_Arr, 2) Step -1 If BE_Arr(3, k) = 0 Then Sheets("ГО").Select Sheets("ГО").Copy After:=Sheets("ГО") Sheets(iNum + 1).Name = BE_Arr(2, k) Sheets(iNum + 1).Cells(8, 1).Value = "Балансовая единица: " & BE_Arr(4, k) Else Sheets(iNum).Cells(8, 1).Value = "Балансовая единица: " & BE_Arr(4, k) End If Next k ' Окончание вставки от 17.05.2012 НР Worksheets("Main").Activate StrADDRess = Worksheets("Main").Range(Cells(x1svod, 5), Cells(x1svod + RowCnt - 1, 31)).Address CopyValue StrADDRess, "2", "Main", "G14" Worksheets("Main").Activate StrADDRess = Worksheets("Main").Range(Cells(x1svod, 5), Cells(x1svod + RowCnt - 1, 11)).Address CopyValue StrADDRess, "Свод", "Main", "G14" Worksheets("Main").Activate StrADDRess = Worksheets("Main").Range(Cells(x1svod, 32), Cells(x1svod + RowCnt - 1, UBound(BE_Arr, 2) + 36)).Address CopyValue StrADDRess, "Свод", "Main", "N14" Worksheets("Main").Activate StrADDRess = Worksheets("Main").Range(Cells(x1svod, 28), Cells(x1svod + RowCnt - 1, 31)).Address CopyValue StrADDRess, "Свод", "Main", ColumnAddress(14 + UBound(BE_Arr, 2)) & "14" Main ("СВод") For Each wSheet In Worksheets ' Удаление треугольных рисунков For Each wShape In wSheet.Shapes wShape.Delete Next If wSheet.Name = "2" Or wSheet.Name = "Свод" Or wSheet.Name = "Detail" Then wSheet.Activate lLastRow = Cells.SpecialCells(xlLastCell).Row lLastCol = Cells.SpecialCells(xlLastCell).Column If wSheet.Name = "2" Or wSheet.Name = "Свод" Then If lLastRow >= 14 Then Range(Cells(14, 1), Cells(lLastRow, lLastCol)).Select 'цвет белый Selection.Interior.ColorIndex = xlNone If lLastCol >= 7 Then Range(Cells(14, 7), Cells(lLastRow, lLastCol)).Select Selection.NumberFormat = "#,##0" End If End If Cells(14, 1).Select ElseIf wSheet.Name = "Detail" Then If lLastRow >= 20 And lLastCol >= 6 Then Range(Cells(20, 6), Cells(lLastRow, lLastCol)).Select Selection.NumberFormat = "#,##0" End If End If End If Next While BECell <> "" ' ts.Write "GlobalFormattingVer01 цикл по БЕ " & Date & " " & Time & CR_ ' ts.Write "BECell = " & BECell & CR_ ' ts.Write "x1 = " & x1 & CR_ ' ts.Write "RowCnt = " & RowCnt & CR_ & CR_ Worksheets(Sourse).Activate StrADDRess = Worksheets(Sourse).Range(Cells(x1, yOffset + 1), Cells(x1 + RowCnt - 1, y1)).Address ' Вставка от 17.05.2012 НР For k = LBound(BE_Arr, 2) To UBound(BE_Arr, 2) If BECell = BE_Arr(1, k) Then BE_Name = BE_Arr(2, k) CopyValue StrADDRess, BE_Name, Sourse, "G14" Worksheets(BE_Name).Select ' Копирование формата ячеек колонки M листа Свод lLastRow = Worksheets(BE_Name).Cells.SpecialCells(xlLastCell).Row If lLastRow >= 14 Then vRange = Range("M14:M" & Trim(Str(lLastRow))).Value Worksheets("Свод").Range("M14:M" & Trim(Str(lLastRow))).Copy Range("M14:M" & Trim(Str(lLastRow))) Range("M14:M" & Trim(Str(lLastRow))).Value = vRange End If ' Конец копирования формата ячеек листа Свод Cells(14, 1).Select Exit For End If Next k ' Окончание вставки от 17.05.2012 НР ' Закомментарил 17.05.2012 НР 'If BECell = "G10" Then CopyValue StrADDRess, "УР", Sourse, "G14" 'If BECell = "G20" Then CopyValue StrADDRess, "АТ", Sourse, "G14" 'If BECell = "G30" Then CopyValue StrADDRess, "АК", Sourse, "G14" 'If BECell = "GQ0" Then CopyValue StrADDRess, "КОС", Sourse, "G14" 'If BECell = "G40" Then CopyValue StrADDRess, "ЮЖ", Sourse, "G14" 'If BECell = "GS0" Then CopyValue StrADDRess, "ШЫМ", Sourse, "G14" 'If BECell = "GS1" Then CopyValue StrADDRess, "АГП ШЫМ", Sourse, "G14" 'If BECell = "G41" Then CopyValue StrADDRess, "АГП", Sourse, "G14" 'If BECell = "G50" Then CopyValue StrADDRess, "УП", Sourse, "G14" 'If BECell = "G60" Then CopyValue StrADDRess, "КО", Sourse, "G14" 'If BECell = "G70" Then CopyValue StrADDRess, "АКТАУ", Sourse, "G14" 'If BECell = "G80" Then CopyValue StrADDRess, "ТАРАЗ", Sourse, "G14" 'If BECell = "G81" Then CopyValue StrADDRess, "АГП ТАРАЗ", Sourse, "G14" 'If BECell = "G90" Then CopyValue StrADDRess, "УКК", Sourse, "G14" 'If BECell = "G99" Then CopyValue StrADDRess, "ГО", Sourse, "G14" 'If BECell = "GA0" Then CopyValue StrADDRess, "УАВРиСТ", Sourse, "G14" 'If BECell = "GA1" Then CopyValue StrADDRess, "АГП УАВРиСТ", Sourse, "G14" 'If BECell = "G32" Then CopyValue StrADDRess, "ББШ Актобе", Sourse, "G14" 'If BECell = "G42" Then CopyValue StrADDRess, "ББШ Южный", Sourse, "G14" 'If BECell = "G62" Then CopyValue StrADDRess, "ББШ Кызылорда", Sourse, "G14" 'If BECell = "G72" Then CopyValue StrADDRess, "ББШ Актау", Sourse, "G14" 'If BECell = "GA2" Then CopyValue StrADDRess, "ББШ УАВРиСТ", Sourse, "G14" 'If BECell = "GQ2" Then CopyValue StrADDRess, "ББШ Костанай", Sourse, "G14" 'If BECell = "GS2" Then CopyValue StrADDRess, "ББШ Шымкент", Sourse, "G14" ' Конец закомментаренного куска 17.05.2012 НР x1 = x1 + RowCnt BECell = Worksheets(Sourse).Cells(x1, 1).Value Wend ' Application.ScreenUpdating = True Worksheets("Свод").Activate End Sub Sub CopyValue(ByVal gggd As String, Prn As String, ByVal Sourse As String, ByVal TargetCell As String) Dim lLastRow As Long, iFound As Long, k As Long If gggd = "" Then Exit Sub ' ts.Write "CopyValue: " & Date & " " & Time & CR_ ' ts.Write "gggd = " & gggd & CR_ ' ts.Write "Prn = " & Prn & CR_ ' ts.Write "Sourse = " & Sourse & CR_ ' ts.Write "TargetCell = " & TargetCell & CR_ & CR_ ' Копировать данные Set rRang = Worksheets(Sourse).Range(gggd) ' rRang.Interior.ColorIndex = xlNone ' Worksheets(Sourse).Range(gggd).Copy 'вставить значения rRang.Copy Sheets(Prn).Range(TargetCell) ' Sheets(Prn).Select ' Range(TargetCell).Select ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'вставить формат ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'цвет белый ' Selection.Interior.ColorIndex = xlNone iFound = 0 For k = LBound(BE_Arr, 2) To UBound(BE_Arr, 2) If Prn = BE_Arr(2, k) Then iFound = k Exit For End If Next k If iFound > 0 Then Sourse = "Свод" ' Закомментарил 17.05.2012 НР ' gggd = "A14:C5000" ' TargetCell = "A14" ' Окончание закомментаренного куска 17.05.2012 НР ' Вставка от 17.05.2012 НР lLastRow = Worksheets(Sourse).Cells.SpecialCells(xlLastCell).Row If lLastRow >= 14 Then gggd = "A14:C" & Trim(Str(lLastRow)) TargetCell = "A14:A14" ' Окончание вставки от 17.05.2012 НР Set rRang = Worksheets(Sourse).Range(gggd) ' Worksheets(Sourse).Range(gggd).Copy 'вставить значения ' Sheets(Prn).Select ' Range(TargetCell).Select ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False rRang.Copy Sheets(Prn).Range(TargetCell) End If End If If False Then Sourse = "Свод" ' Вставка от 17.05.2012 НР lLastRow = Worksheets(Sourse).Cells.SpecialCells(xlLastCell).Row If lLastRow >= 14 Then gggd = "A14:C" & Trim(Str(lLastRow)) TargetCell = "A14:A14" ' Окончание вставки от 17.05.2012 НР ' Закомментарил 17.05.2012 НР ' gggd = "A14:AA5000" ' TargetCell = "A14" ' Окончание закомментаренного куска 17.05.2012 НР Worksheets(Sourse).Range(gggd).Copy 'вставить формат Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'цвет белый Selection.Interior.ColorIndex = xlNone ' Вставка от 17.05.2012 НР End If End If ' Окончание вставки от 17.05.2012 НР ' Вставка от 17.05.2012 НР ' Worksheets(Sourse).Range(gggd).Copy Sheets(Prn).Range(TargetCell) ' Окончание вставки от 17.05.2012 НР End Sub Sub Clear(Prn As String, Begin_Row As Long) Dim lLastRow As Long, k As Long, Beg_Row As Long Dim rDest As Range ' ts.Write "Clear: " & Date & " " & Time & CR_ ' ts.Write "Prn = " & Prn & CR_ ' ts.Write "Begin_Row = " & Begin_Row & CR_ & CR_ lLastRow = Worksheets(Prn).Cells.SpecialCells(xlLastCell).Row Set rDest = Nothing If Begin_Row > 0 Then Beg_Row = Begin_Row Else Beg_Row = 14 End If For k = Beg_Row To lLastRow If rDest Is Nothing Then Set rDest = Worksheets(Prn).Rows(k) Else Set rDest = Union(rDest, Worksheets(Prn).Rows(k)) End If Next k If lLastRow >= Beg_Row Then rDest.Delete End If ' Worksheets(Prn).Range("A14:Z5000").Delete Shift:=xlUp End Sub Sub Del_Col(Prn As String, Begin_Col As Long) Dim lLastCol As Long, k As Long, Beg_Col As Long Dim rDest As Range ' ts.Write "Clear: " & Date & " " & Time & CR_ ' ts.Write "Prn = " & Prn & CR_ ' ts.Write "Begin_Col = " & Begin_Col & CR_ & CR_ lLastCol = Worksheets(Prn).Cells.SpecialCells(xlLastCell).Column Set rDest = Nothing If Begin_Col > 0 Then Beg_Col = Begin_Col Else Beg_Col = 5 End If For k = Beg_Col To lLastCol If rDest Is Nothing Then Set rDest = Worksheets(Prn).Columns(k) Else Set rDest = Union(rDest, Worksheets(Prn).Columns(k)) End If Next k If lLastCol >= Beg_Col Then rDest.Delete End If ' Worksheets(Prn).Range("A14:Z5000").Delete Shift:=xlUp End Sub Sub Main(Prn As String) Dim s_ As String Dim iNum As Long Dim Sourse As String Dim dx As Long, delta As Long, f As Long ' ts.Write "MAIN: " & Date & " " & Time & CR_ ' ts.Write "Prn = " & Prn & CR_ & CR_ Sourse = "Main" dx = MainResult.Rows.Count + MainResult.Row - 1 Set rRang = Worksheets(Sourse).Range("A" + Trim(Str(MainResult.Row + 2)) + ":A" + Trim(Str(dx))) ' Worksheets(Sourse).Range("A" + Trim(Str(MainResult.Row + 2)) + ":A" + Trim(Str(dx))).Copy 'вставить значения rRang.Copy Sheets(Prn).Range("C14:C14") ' Sheets(Prn).Select ' Range("C14").Select ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'вставить формат ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'цвет белый ' Selection.Interior.ColorIndex = xlNone 'Копировать данные Set rRang = Worksheets(Sourse).Range("B" + Trim(Str(MainResult.Row + 2)) + ":C" + Trim(Str(dx))) ' Worksheets(Sourse).Range("B" + Trim(Str(MainResult.Row + 2)) + ":B" + Trim(Str(dx))).Copy 'вставить значения rRang.Copy Sheets(Prn).Range("A14:B14") ' Sheets(Prn).Select ' Range("A14").Select ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'вставить формат ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'цвет белый ' Selection.Interior.ColorIndex = xlNone ' Set rRang = Worksheets(Sourse).Range("B" + Trim(Str(MainResult.Row + 2)) + ":B" + Trim(Str(dx))) ' Worksheets(Sourse).Range("B" + Trim(Str(MainResult.Row + 2)) + ":B" + Trim(Str(dx))).Copy Worksheets(Prn).Select ' Range("B14").Select 'вставить формат ' rRang.Copy Sheets(Prn).Range("B14:B14") ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' Selection.Interior.ColorIndex = xlNone 'Exit Sub delta = 4 ' ts.Write "MAIN: for each c dx = " & dx & " begin " & Date & " " & Time & CR_ ' For Each c In Worksheets(Prn).Range("F14:F" + Trim(Str(dx - delta))) Worksheets(Prn).Range("M14:M" & Trim(Str(dx - delta))).Font.Underline = True Worksheets(Prn).Range("A14:B" & Trim(Str(dx - delta))).NumberFormat = "@" For iNum = 14 To dx - delta ' If InStr(Worksheets(Sourse).Cells(c.Row + delta, 4).Value, "#") = 0 And Worksheets(Sourse).Cells(c.Row + delta, 4).Value <> "" Then' If Len(Worksheets(Sourse).Cells(iNum + delta, 4).Value) <= 5 Then ' MsgBox Worksheets(Sourse).Cells(c.Row + delta, 4).Value Cells(iNum, 13).Font.Underline = False End If If InStr(Trim(Cells(iNum, 1).Value), ".") = 0 Then s_ = Cells(iNum, 1).Value Cells(iNum, 1).Value = Worksheets(Prn).Cells(iNum, 2).Value Cells(iNum, 2).Value = s_ End If If False Then If InStr(Worksheets(Sourse).Cells(iNum + delta, 3).Value, "#") = 0 And Worksheets(Sourse).Cells(iNum + delta, 3).Value <> "" Then Cells(iNum, 1).NumberFormat = "@" Cells(iNum, 1).Value = Worksheets(Sourse).Cells(iNum + delta, 3).Value End If End If If Left(Trim(Cells(iNum, 1).Value), 1) = "Z" Then Cells(iNum, 1).Value = Cells(iNum, 2).Value Cells(iNum, 2).Value = "" End If If Right(Trim(Cells(iNum, 1).Value), 1) <> "." Then ' Cells(iNum, 2).NumberFormat = "@" Cells(iNum, 1).Value = Cells(iNum, 1).Value & "." End If ' Cells(iNum, 2).Value = Replace(Worksheets(Prn).Cells(iNum, 2).Value, "Z", "") ' Cells(iNum, 6).WrapText = True Next iNum ' ts.Write "MAIN: for each c end " & Date & " " & Time & CR_ & CR_ f = dx + 1 Worksheets(Prn).Range("A3:A4").Font.Bold = True Worksheets(Prn).Range("A3:A4").Font.Size = 14 ' Rows("1:1").Select 'Страница 'Выключаем отображение на экран для повышения скорости работы. ' Call SM("АГП", "УР", dx) ' Call SM("АГП", "АТ", dx) ' Call SM("АГП", "УП", dx) ' Call SM("АГП", "ЮЖ", dx) ' Call SM("АГП", "КО", dx) Call SM("Свод", "2", dx - delta) ' Call SM("АГП", "Свод", dx) ' Call SM("АГП", "ГО", dx) ' Call SM("АГП", "АКТАУ", dx) ' Call SM("АГП", "ТАРАЗ", dx) ' Call SM("АГП", "УКК", dx) End Sub Sub SM(Sourse As String, ByVal Prn As String, ByVal Bx As Integer) Dim iNum As Long ' ts.Write "SM: " & Date & " " & Time & CR_ ' ts.Write "Sourse = " & Sourse & CR_ ' ts.Write "Prn = " & Prn & CR_ ' ts.Write "Bx = " & Bx & CR_ & CR_ Set rRang = Worksheets(Sourse).Range("A14:F" + Trim(Str(Bx))) ' + 10))) ' Worksheets(Sourse).Range("A14:F" + Trim(Str(Bx + 10))).Copy 'вставить значения ' Worksheets(Prn).Select ' Range("A14").Activate rRang.Copy Sheets(Prn).Range("A14:A14") ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'вставить формат ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' ts.Write "SM for each c Bx = " & Bx & " begin: " & Date & " " & Time & CR_ Set rRang = Worksheets(Sourse).Range("M14:M" + Trim(Str(Bx))) ' + 10))) ' Worksheets(Sourse).Range("M14:M" + Trim(Str(Bx + 10))).Copy 'вставить значения rRang.Copy Sheets(Prn).Range("M14:M14") ' Worksheets(Prn).Select ' Range("M14").Activate 'вставить формат ' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' For Each c In Worksheets(Prn).Range("M14:M" + Trim(Str(Bx + 10))) ' For iNum = 14 To Bx + 10 ' Cells(iNum, 13).Font.Underline = Worksheets(Sourse).Cells(iNum, 13).Font.Underline ' Cells(iNum, 13).NumberFormat = Worksheets(Sourse).Cells(iNum, 13).NumberFormat ' Cells(iNum, 13).WrapText = Worksheets(Sourse).Cells(iNum, 13).WrapText ' Next ' ts.Write "SM for each c end: " & Date & " " & Time & CR_ & CR_ On Error Resume Next Worksheets(Prn).PageSetup.RightFooter = "Страница &С из &К" End Sub Function ColumnAddress(ColNum As Integer) Dim i As Integer, j As Integer Dim Result As String i = Int(ColNum / 26) j = ColNum Mod 26 If j = 0 Then i = i - 1 j = 26 End If If i > 0 And i <= 26 Then Result = Chr(64 + i) Else Result = "" End If Result = Result & Chr(64 + j) ColumnAddress = Result End Function |
Автор: | Air_demon [ Пт, окт 19 2018, 15:03 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Почитайте статью по ссылке, обратив внимание на вариант 4. http://perfect-excel.ru/publ/excel/makrosy_i_programmy_vba/sheet_happens/7-1-0-96 |
Автор: | fifty [ Пт, окт 19 2018, 15:15 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Такого Листа "Setup" в рабочей книге нет, может быть он должен как-то появляться сам сформировываться. Даже в ручную добавляя такой Лист "Setup", макрос все равно не отрабатывает. |
Автор: | Air_demon [ Пт, окт 19 2018, 15:33 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Судя по коду макроса этот лист должен содержать определенные настройки для формирования отчета. ' Заполнение массива БЕ iNum = 1 kol_be = 0 Do While Setup.Cells(iNum, 14).Value <> "" kol_be = kol_be + 1 ReDim Preserve BE_Arr(1 To 4, 1 To kol_be) As Variant BE_Arr(1, kol_be) = Setup.Cells(iNum, 14).Value BE_Arr(2, kol_be) = Setup.Cells(iNum, 15).Value BE_Arr(3, kol_be) = Setup.Cells(iNum, 16).Value BE_Arr(4, kol_be) = Setup.Cells(iNum, 17).Value |
Автор: | Kavaii [ Чт, окт 25 2018, 14:12 ] |
Заголовок сообщения: | Re: Слетел макрос в рабочей книге BW |
Цитата: А как посмотреть диспетчер имен в рабочей книге? открыть эксель -> Вкладка формулы -> диспетчер имён Цитата: Такого Листа "Setup" в рабочей книге нет, может быть он должен как-то появляться сам сформировываться. Даже в ручную добавляя такой Лист "Setup", макрос все равно не отрабатывает. Setup - это переменная, соответствующая листу в книге Например у вас есть настроенный лист с названием "Настройка", тогда нужно добавить после Code: Option Explicit следующее: Code: Public Setup As Worksheet
Set Setup = Sheet("Настройка") |
Страница 1 из 1 | Часовой пояс: UTC + 3 часа |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |