Заполнение данных в макете этикетки из таблицы

[Kapany3uk]

Сообщение от Aleksandr H.

В общих словах как-то так

R = 1
s3.Cells(1, y) => s3.Cells(R, y)
y = y + 3
if y > 10 then
 y = 1:r = r + 23
end if

Прошу прощения, что то не работает(( ошибку выдает. Ругается на значек =>
Может не туда вставляю код?

Подскажите куда его нужно вставить в моем коде?

[Kapany3uk]

заранее благодарен

[Aleksandr H.]

Сообщение от Kapany3uk

Прошу прощения, что то не работает((

Ааа, так это вместо Вас надо весь код написать?

[Kapany3uk]

Сообщение от Aleksandr H.

Ааа, так это вместо Вас надо весь код написать?

не весь только код повторения

[Kapany3uk]

Сообщение от Aleksandr H.

Ааа, так это вместо Вас надо весь код написать?

спасибо, разобрался

[Kapany3uk]

Вот что получилось.

Подскажите что опять не так сделал? По идее каждая 22 строчка (то есть 22,44,66,88 и т.д.) должен меняться размер, а у меня почему то меняется только в 44 и в 110 строчке

Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim s3 As Worksheet
    Dim x As Integer
    Dim y As Integer
    Dim Z As Integer
    Dim R As Integer
    Dim iRow As Integer
    x = 1
    Set s1 = Sheets(1)
    Set s2 = Sheets(2)
    Set s3 = Sheets(3)
    x = s1.Cells(s1.Rows.Count, "A").End(xlUp).Row
    iRow = 2
    y = 1
    Z = 3
    a = 22
    R = 1
      Do While (iRow <= x)
      If y >= 10 Then
      a = a + 22
      y = 1: R = R + 22
      End If
        s2.Range("B1:B14").Value = Application.Transpose(s1.Range("A" & iRow & ":N" & iRow).Value)
        s2.Range("A1:B22").Copy
        s3.Cells(R, y).PasteSpecial Paste:=xlPasteColumnWidths
        s3.Cells(R, y).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        s3.Cells(R, y).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
        Selection(a).RowHeight = 3
        Columns(Z).ColumnWidth = 0.35
        Z = Z + 3
        y = y + 3
        Application.CutCopyMode = False
        iRow = iRow + 1
    Loop

[Aleksandr H.]

s3.Rows(a).RowHeight = 3

вместо

Selection(a).RowHeight = 3

пробовали?

[Kapany3uk]

Сообщение от Aleksandr H.

s3.Rows(a).RowHeight = 3

вместо

Selection(a).RowHeight = 3

пробовали?

нет не пробовал, спасибо большое все заработало.
Не ругайте сильно, я только учусь.

[Kapany3uk]

Всем доброго дня, продолжу в своей теме, что бы не плодить новых)) Возник следующий вопрос - как отредактировать формат для печати, что бы граница печати была по низу этикеток.
где то нашел вот такой макрос, но к сожалению он больше для текста подходит((
Сейчас у меня получается что часть этикетки печатается на одном листе а часть на другом(( то есть нет разделения на листы, все идет сплошным текстом.

Application.ScreenUpdating = False  'отключаем обновление экрана для скорости

     With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1000
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .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
    ActiveWindow.View = xlPageBreakPreview
    Application.ScreenUpdating = True

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

[Kapany3uk]

Всем доброго дня, готовое решение выложил в теме http://www.programmersforum.ru/showt...=326176&page=2

Но есть вопросы, кто сможет помочь , буду признателен