Страницы: 1
RSS
ссылка на активные листы создаваемые сводной таблицей в VBA
 
Доброго времени суток!
Я не разбираюсь в кодах VBA, но принципы их работы понимаю.
Ребята, проблема следующая:
есть файл, в котором есть сводная таблица, мне необходимо прописать макрос который будет выдавать детали по каждой строчки на новом листе.
после чего его нужно будет отредактировать под формат листа для печати. и распечатать.
собственно с этим проблемы нет, это я могу сделать путем записи последовательных действий. проблема возникает в следующем, после записи и сохранения макроса, при попытке его запустить выдает ошибку. т.к. в коде VBA он ссылается на конкретное имя листа, а при выдаче деталей на отдельный лист создается лист с новым именем, не указанным в коде. что можно прописать в коде чтобы макрос работал с только что созданным листом. при выдаче  деталей новый лист становится активным.
Вот код который у меня получился:
Скрытый текст

Прошу прощения за возможно, размытый вопрос. постарался максимально подробно описать проблему.

На панели над полем для сообщения куча кнопок форматирования. Пользуйтесь[МОДЕРАТОР]

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
Добрый день!
нет вариантов?
ведь как-то это же можно сделать... не понятно только как...

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
Немного не понял смысла вопроса относительно Вашего кода, который просто форматирует данные на листе. Что касается того, как обратиться к последнему созданному листу, попробуйте делать это не по имени, а по индексу (далее .Select или то, что нужно)
Код
Sheets(Sheets().Count)

 
ну так вы и работаете с активным в чем проблема?
Живи и дай жить..
 
А зачем скобочки внутри? )
 
Юрий М, по привычке :)
 
Доброго времени суток, Друзья!

Из того что вы мне посоветовали, ничего не подошло. Копался по форуму, тож не нашел нужного. Увидел у коллег похожий макрос, адаптировал под себя и вот что у меня получилось:
Код
Sub MiseEnPage()
' FicheRupture Macro
' Macro enregistrée le 05/06/2009 par DDF0472153
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintTitleRows = "$1:$1"
        .CenterFooter = "Page &P de &N"
    End With
    Rows("1:1").Select
    Selection.Style = "Tableau rupture"
    Range("A2:O1000").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Columns("E:E").ColumnWidth = 4.14
    Columns("F:F").ColumnWidth = 4.57
    Columns("G:G").ColumnWidth = 4.14
    Columns("H:H").ColumnWidth = 6.86
    Columns("I:I").ColumnWidth = 6.14
    Columns("J:J").ColumnWidth = 14.86
    Columns("K:K").ColumnWidth = 4.14
    Columns("M:M").ColumnWidth = 10.86
    Columns("N:N").ColumnWidth = 32.57
    Columns("O:O").ColumnWidth = 45.86
    Range("G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    Selection.Columns.AutoFit
End Sub
На этом сайте я многое узнал благодаря Вам!
Спасибо Всем за участие!!!

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
Ребят, теперь нужно, чтобы в промежутке между 60 и 61 строчках производилась сортировка в столбце "B". Никак не могу сообразить как это сделать...
я сделал так:
Код
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("B2:O10")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Этот код вставил в строчку между 60 и 61, но сортировки по столбцу не происходит...
Подскажите где ошибка?

Спасибо!

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
Первые две строчки не нужны.
В 7 строке задается диапазон сортировки B2:010. Это правильный диапазон?
F1 творит чудеса
 
Да, диапазон правильный, там буква О, а не ноль. Но он может меняться в зависимости от кол-ва столбцов. т.е. сортировка распространяется на все строки. Может можно обойтись без него? или может задать его шире?

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
попробуйте так
Код
ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("B1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

либо, если столбец А почему-то не должен сортироваться (??? наверное все-таки должен, выгрузка же с первого столбца идет), то
Код
ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("B1").CurrentRegion.Offset(0, 1).Resize(, Range("B1").CurrentRegion.Columns.Count - 1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
F1 творит чудеса
 
Максим, Вы просто Гений!
В "А" все значения одинаковые.
Все работает!
Круто спасибо!

Бессмысленно осмысливать смысл неосмысленными мыслями.
 
Ну, это слишком  )))
F1 творит чудеса
 
Я с этим файлом мучился уже пару месяцев как. а тут: Хоп, и вопрос решен!

Бессмысленно осмысливать смысл неосмысленными мыслями.
Страницы: 1
Наверх