| |
こんにちは。
ＶＢＡ初心者です。
現在のソースでは「sheet1」で下記のコマンドを実行しているのですが、
「sheet2」に下記のコマンドボックスを作成する場合、「sheet1」のデータ
を見るように指定するにはどうしたらよいでしょうか。
myPath = ActiveWorkbook.Path & "\"の部分かと思い、myPath = ThisWorkbook.Worksheets(1).Activate
などのように記載しても出力されなかったりしてしまいます。
どのうようにしたらよいかご教授をお願い致します。
-----------------------------------VbA-----------------------------------------
Sub Lesson_Print2() 'タイトル2行
Dim Tbl As Range
Dim v, i As Long, n As Long, n1 As Long
Dim myPath As String
Dim newBook As Workbook
Dim Bookname As String
Application.DisplayAlerts = False
myPath = ActiveWorkbook.Path & "\"
Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み
n = Tbl.Rows.Count
v = Tbl.Resize(n + 1, 1).Value
n1 = 3 '◆変更
For i = 3 To n '◆変更
If v(i, 1) <> v(i + 1, 1) Then '下と違えば
With Workbooks.Add(xlWBATWorksheet) '◆変更 シート1枚のBook
Tbl.Rows("1:2").Copy .Sheets(1).[A1] '◆見出し行2行をCopy
Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A3] '3行目へ
.Sheets(1).UsedRange.EntireColumn.AutoFit '◆挿入
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.787)
.RightMargin = Application.InchesToPoints(0.787)
.TopMargin = Application.InchesToPoints(0.984)
.BottomMargin = Application.InchesToPoints(0.984)
.HeaderMargin = Application.InchesToPoints(0.512)
.FooterMargin = Application.InchesToPoints(0.512)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 200
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
Bookname = v(i, 1) '↓ A列データが日付のときはBook名をFormatする
If IsDate(Bookname) Then Bookname = Format$(v(i, 1), "yy-mm-dd")
.SaveAs myPath & v(i, 1) & ".xls", FileFormat:=XlFileFormat.xlExcel8
.Close False
End With
n1 = i + 1
End If
Next
'Application.SheetsInNewWorkbook = nSheet
MsgBox "出力しました"
End Sub
-----------------------------------------------------------------------------------------
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
