数式が消える

Sub Print_Out_1()
'セルに値を設定しながら連続印刷する。印刷対象：アクティブシート

Dim Message As Long
Message = MsgBox("印刷してもいいですか？？", vbOKCancel, "メディカルＧ")

If Message = vbOK Then

Application.ScreenUpdating = False


ActiveSheet.Unprotect Password:="0630"
ActiveSheet.PageSetup.PrintArea = "B11:O30"
'定数
Const conStart As Long = 1 '開始
Const conStep As Long = 1 '間隔
Const conCell As String = "K7" 'セル番地

'変数
Dim i As Long
Dim conEnd As Integer '終了


With Application
.ScreenUpdating = False
conEnd = Val(.ActiveSheet.Range(conCell).Value)
If conEnd >= 1 Then
For i = conStart To conEnd Step conStep
Range(conCell).Value = i '←追加コード
ActiveSheet.PrintOut
Next
End If
.ScreenUpdating = True
End With

Application.ScreenUpdating = True

MsgBox "印刷が完了しました。"
ActiveSheet.PageSetup.PrintArea = False
ActiveSheet.Protect Password:="0630"

End If

End Sub

のようなコードが書かれたExcelがあります。
通常にXを押してExcelを閉じると何故か次に立ち上げて使用した時、数式が消えてしまいます。
消えないようにしたいのですがわかりません。教えて頂けないでしょうか・・・

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2023/03/19 18:39

こんばんは

＞数式が消えてしまいます。
何処の数式でしょうか？K７セルならば
Range(conCell).Value = i '←追加コード
K７セルに書き込んでいますね　目的は？　
もし、印刷の内容に必要な事ならば（印刷範囲に入っていない気がしますが）違うセルに変更するか・・・
VBAコードを下記のように変えてみてください

式を一旦　変数に入れ　処理の最後に戻して（書き込み）います
Sub Print_Out_1()
'セルに値を設定しながら連続印刷する。印刷対象：アクティブシート

Dim Message As Long
Message = MsgBox("印刷してもいいですか？？", vbOKCancel, "メディカルＧ")

If Message = vbOK Then

Application.ScreenUpdating = False


ActiveSheet.Unprotect Password:="0630"
ActiveSheet.PageSetup.PrintArea = "B11:O30"
'定数
Const conStart As Long = 1 '開始
Const conStep As Long = 1 '間隔
Const conCell As String = "K7" 'セル番地

'変数
Dim i As Long
Dim conEnd As Integer '終了

Dim tmp_Formula As String
'変数に入れる
tmp_Formula = ActiveSheet.Range(conCell).Formula
With Application
.ScreenUpdating = False
conEnd = Val(.ActiveSheet.Range(conCell).Value)
If conEnd >= 1 Then
For i = conStart To conEnd Step conStep
Range(conCell).Value = i '←追加コード
ActiveSheet.PrintOut
Next
End If
.ScreenUpdating = True
End With
Application.ScreenUpdating = True
MsgBox "印刷が完了しました。"
'戻す
ActiveSheet.Range(conCell).Formula = tmp_Formula
ActiveSheet.PageSetup.PrintArea = False
ActiveSheet.Protect Password:="0630"

End If

End Sub

この回答へのお礼

ありがとうございます。
できました。助かりました・・・；；

書き込み？
まだまだ初心者でどこが悪いのかさっぱりわからなかったので・・・；；
本当にたすかりました・・m(__)m

お礼日時：2023/03/19 18:52