excel vba 印刷範囲の設定
解決したいこと
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