@frswataru (本石 渉)

Are you sure you want to delete the question?

Leaving a resolved question undeleted may help others!

excel vba 印刷範囲の設定

Q&A

Closed

解決したいこと

vbaを使って印刷範囲の設定したいのですが上手くいません。
解決方法を教えて下さい。

該当するソースコード#1


Dim ws1, ws2, ws3 As Worksheet
Dim i As Long
Sub Samurazu()

Call Read1


Set ws1 = Worksheets("T_ProductControlData")
Set ws2 = Worksheets("Element")
Set ws3 = Worksheets("Summary")


With ws1.Range("A1").CurrentRegion
    sRow = .Item(1).Row
    sCol = .Item(1).Column
    eRow = .Rows.Count + sRow - 1
    eCol = .Columns.Count + sCol - 1
    RowCnt = Cells(Rows.Count, 8).End(xlUp).Row
End With




Dim i As Long
For i = 1 To eRow

    If ws1.Cells(i, 1) = ws1.Cells(i + 1, 1) And _
       ws1.Cells(i, 4) <> ws1.Cells(i + 1, 4) Then

        ws1.Select
        Range(Cells(1, 3), Cells(i, 9)).Copy


        ws2.Select
        Cells(6, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False


       Call チャート作成


        ws2.Range(Rows(6), Rows(i + 5)).Copy


        With ws3.Range("A5").CurrentRegion
            sRow_3 = .Item(1).Row
            sCol_3 = .Item(1).Column
            eRow_3 = .Rows.Count + sRow_3 - 1
            eCol_3 = .Columns.Count + sCol_3 - 1
        End With


        ws3.Select
        Cells(eRow_3 + 1, 1).Select
        ActiveSheet.Paste



        ws2.Select
        ws2.DrawingObjects.Select
        Selection.Delete
        Range("A6").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents

        ws1.Select
        Range(Rows(1), Rows(i)).Select
        Selection.Delete Shift:=xlUp
        i = 1
    ElseIf Cells(i, 2) <> Cells(i + 1, 2) Then

         ws1.Select
        Range(Cells(1, 3), Cells(i, 9)).Copy

         ws2.Select
        Cells(6, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False


       Call チャート作成


        ws2.Range(Rows(6), Rows(i + 5)).Copy


        With ws3.Range("A5").CurrentRegion
            sRow_3 = .Item(1).Row
            sCol_3 = .Item(1).Column
            eRow_3 = .Rows.Count + sRow_3 - 1
            eCol_3 = .Columns.Count + sCol_3 - 1
        End With


        ws3.Select
        Cells(eRow_3 + 1, 1).Select
        ActiveSheet.Paste



        ws2.Select
        ws2.DrawingObjects.Select
        Selection.Delete
        Range("A6").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents

        ws1.Select
        Range(Rows(1), Rows(i)).Select
        Selection.Delete Shift:=xlUp

        ws3.Cells(1, 2) = ws1.Cells(i, 1)
        ws3.Cells(2, 2) = ws1.Cells(i, 2)

        
        Call test

        Exit Sub




    End If

Next




End Sub

該当するソースコード#2

Sub test()

Dim ws4 As Worksheet
Dim eor As Long

Set ws4 = Worksheets("Summary")

eor = ws4.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print (eor)

Dim myRange As Range
Set myRange = Range(Cells(1, 1), Cells(eor, 84))
ActiveSheet.PageSetup.PrintArea = myRange.Address



End Sub
0 likes

No Answers yet.

Your answer might help someone💌