プロが教える店舗&オフィスのセキュリティ対策術

エクセルにて添付画像のようなSheet1表のA2,B2,C2セルに入力しSheet1を印刷すると
Sheet2の表にA2,B2,C2の入力内容を随時記録し保管するようなVBのプログラムを作りたいのですが
私がエクセルVB初心者でしてわかりません
どうか、プログラムを教えていただけませんでしょうか?

※Sheet2の日付は、印刷した日付(年・月・日)です
※プログラムですが、解説も入れていただけると幸いです

よろしくお願いします

「エクセルVBAプログラム教えてください」の質問画像

A 回答 (3件)

こんにちは!



一案です。
>Sheet1を印刷すると・・・
ではなく
Sheet1にコマンドボタン等を配置し、そのボタンをクリックすると
Sheet2にデータを保存 → 印刷
といった手順ではどうでしょうか?

Excel2010の場合で説明すると
コマンドボタンでなくオートシェイプを使う方法でやってみます。

① メニュー → 挿入 → 図形 → 好みの図形をSheet1上に配置
② 配置したオートシェイプ上で右クリック → マクロの登録 → 新規作成
③ 表示された画面に↓のコードをえコピー&ペースト
※ コードは「テキストボックス」を挿入した場合のコードで1行目と最終行は表示されていますので
2行目~最後から2行目までをコピー&ペーストします。
(オートシェイプによって1行目のボタンの名前が自動で変わります)
④ オートシェイプを印刷しない場合
オートシェイプ上で右クリック → 図形の書式設定 → プロパティ → 「オブジェクトを印刷する」のチェックを外しておきます。

Sub テキストボックス1_Click()
Dim wS As Worksheet
Set wS = Worksheets("Sheet2")
'▼A2~C2セルに未入力がなければ・・・
If WorksheetFunction.CountBlank(Range("A2:C2")) = 0 Then
'▼Sheet2のA列最終行の1行下のセル
With wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
'▼の値は「本日」
.Value = Date
'▼1列右側のセルはA2の値
.Offset(, 1) = Range("A2")
'▼2列右側の値はB2セルの値
.Offset(, 2) = Range("B2")
'▼3列右側の値はC2セルの値
.Offset(, 3) = Range("C2")
End With
'▼A2~C2セルのデータを消去
Range("A2:C2").ClearContents
'▼Sheet1を印刷プレビュー
ActiveSheet.PrintPreview '★
Else
MsgBox "未入力セルがあります"
End If
End Sub

※ 印刷プレビューでやめていますので、すぐに印刷する場合は「★」の行の
>ActiveSheet.PrintPreview '★
の行を
> ActiveSheet.PrintOut
に変更してください。

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0

定番の作業であり、定番のコードですので


きちんと理解してください。

Sub ボタン1_Click()
With Sheets("Sheet2")
GYOU = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & GYOU).Value = Date
.Range("B" & GYOU).Value = Range("A2").Value
.Range("C" & GYOU).Value = Range("B2").Value
.Range("D" & GYOU).Value = Range("C2").Value
End With
ActiveSheet.PrintPreview
End Sub

実際は
PrintPreview

PrintOut
でも良いです。
    • good
    • 0

Workbook_BeforePrintイベントプロシャに書いちゃうっていう手もありますよ。

(すいません。プログラムはNo.2さんのパクリです)
Workbook_BeforePrintイベントプロシャは、印刷の指示を行った時、その印刷の前に実行されます。
ただし、これには致命的欠点があります。これだとSheet2を印刷しても補完してしまいます。
やっぱり、No.2さんのが正解ですね。

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim GYOU As Long

Cancel = True 'Trueを設定すると印刷動作はキャンセルされます。テストが終ったらこの行は削除してください。

With Sheets("Sheet2")
GYOU = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & GYOU).Value = Date
.Range("B" & GYOU).Value = Range("A2").Value
.Range("C" & GYOU).Value = Range("B2").Value
.Range("D" & GYOU).Value = Range("C2").Value
End With
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!