| 
    
     |  | >外部の為、日々のデータの受け渡しがFD マシン間の距離とか導入コストの問題などもありますが、出来たらピアツーピアでも
 いいから、LANを構築した方が楽ですよ。そうすればマクロでデータを引っ張ることも
 出来るので
 >日々毎朝その日分を作っていきながら回す
 という作業から、開放されそうだからです。
 >でも、入庫量が日々まちまちで、多い日は数千ケース、少ない日は数十ケースてな
 >感じなんで、雛形が大きな表になってしまい、まして、日々、シートを印刷まで
 >しているので、ここも頭が痛いんです
 この場合「データ未入力の行を一気に非表示にする」というマクロを組むだけです。
 例えば B列を基準とするなら
 
 Sub R_Hidden_Change()
 Static Hck As Boolean
 
 On Error Resume Next
 If Hck = False Then
 If WorksheetFunction.CountA(Range("B:B")) = 0 Then
 MsgBox "B列に値がありません", 48: Exit Sub
 End If
 Range("B1", Range("B65536").End(xlUp)) _
 .SpecialCells(4).EntireRow.Hidden = True
 Hck = True
 Else
 Cells.EntireRow.Hidden = False
 Hck = False
 End If
 End Sub
 
 これを実行する度に、アクティブシートの空白行の表示・非表示が切り替えられます。
 列のデータを合計する数式が、B列最終入力行(5000でも10000でも)にあれば、
 項目と合計との間の空白が処理されるわけです。合計値の目視確認だけでなく、
 印刷時にも非表示行は印刷されません。プレビューで確認してみて下さい。
 >原紙のシートモジュールと標準モジュールが各シートにコピーされていません。
 シートを丸ごとコピーすると、シートモジュールのコードは付いてくるはずです。
 こちらでもテストで確認しています。標準モジュールについては無理ですから、
 まずVBE画面でコピーしたいモジュールをアクティブにして「ファイル」「ファイルの
 エクスポート」で任意のフォルダーに保存して下さい。そのフルパスを下のコードの
 定数 Mdl に指定します。するとコードによってActiveWorkbookにインポートされます。
 ついでに他のモジュールも、バックアップしておくと良いでしょう。予期せずブックが
 破損したときに、バックアップファイルがあると助かりますよ。
 >普通にシートタグを右クリックして[移動またはコピー]でコピーすると、
 >セル幅、高さもきれいにコピーされますが、今回の各シートはセル幅、高さとも
 >コピーされていません。
 これはこちらでも確認しました。UsedRangeでコピーしていたためのようです。
 Cells全体をコピーするコードに変えた結果、行高・列幅も反映されています。
 
 ↓の改造したコードで試してみて下さい。結果を直ぐにチェックできるよう、
 ブックの Closeメソッドはコメントにしています。本番では "'" を外します。
 なお、実行前に原紙シート名の変更、およびモジュールのエクスポートと定数値の変更
 をお忘れなく。
 
 Sub ThisMonth_Make_NewBook2()
 Dim MkFile As String
 Dim Ans As Integer, Scnt As Integer, NewS As Integer
 Dim SDay As Date
 Dim WS As Worksheet
 Const Mdl As String = _
 "C:\Documents and Settings\User\My Documents\モジュール\Module1.bas"
 
 MkFile = Application.DefaultFilePath & _
 "\" & Month(Date) & "月.xls"
 If Dir(MkFile) <> "" Then
 Ans = MsgBox("今月のブックは既に存在します" & vbLf & _
 "削除して新規にブックを作成しますか", 36)
 If Ans = 7 Then Exit Sub
 End If
 NewS = Day(DateSerial(Year(Date), Month(Date) + 1, 1) - 1)
 SDay = DateSerial(Year(Date), Month(Date), 1)
 With Application
 Scnt = .SheetsInNewWorkbook
 .SheetsInNewWorkbook = NewS
 .ScreenUpdating = False
 End With
 Workbooks.Add
 With ActiveWorkbook
 For Each WS In .Worksheets
 WS.Name = CStr(Format(SDay, "m月d日"))
 SDay = SDay + 1
 Next
 ThisWorkbook.Sheets("test").Copy Before:=.Worksheets(1)
 .Sheets.FillAcrossSheets .Sheets("test").Cells
 .Sheets("test").Visible = False
 .VBProject.VBComponents.Import Mdl
 .SaveAs MkFile
 '.Close
 End With
 With Application
 .ScreenUpdating = True
 .SheetsInNewWorkbook = Scnt
 End With
 End Sub
 
 |  |