Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


20063 / 76732 ←次へ | 前へ→

【62094】マクロ実行後の「名前を付けて保存」をキャンセル
質問  まき子  - 09/6/22(月) 14:18 -

引用なし
パスワード
   XP office2003
お願いします。

Book(3シート有)をマクロ実行で2シートを削除し、1シートにしたファイルを任意の場所に新しく名前を付けて保存します(ファイルは新しい名前で開かれている)。
ところがその新しいファイルを閉じる時
1.「保存しますか/はい」で保存し、その後開くとマクロの実行通り1シートになっている。
2.「保存しますか/いいえorキャンセル」し、その後開くとマクロ実行前の3シートのままである。
という状態です。2度保存しなければマクロ実行後の内容にならないのは、下記のどの部分を修正すればよいでしょうか?
よろしくお願い致します。
Sub ファイル保存()

  Dim myFileName As String  
  fn = ThisWorkbook.ActiveSheet.Range("C3") '拠点名
  fn2 = "結果" & "(" & fn & ")"    '新しいBook名。
    '名前を付けて保存ダイアログボックスを開く
    myFileName = Application.GetSaveAsFilename(fn2, "Excelファイル(*.xls),*.xls")
    If myFileName = "False" Then
      Exit Sub
    Else
      With Application
        ActiveWorkbook.SaveAs myFileName, FileFormat:=xlNormal, _
        Password:="6920", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
      End With
    End If

  ActiveWorkbook.Password = ""     'WriteRes解除
  
  Application.ScreenUpdating = False  '画面表示を更新しない(画面を止める)
  Application.DisplayAlerts = False   '警告メッセージを表示させない
  
  Sheets("入力シート").Select
    ActiveSheet.Unprotect Password:="69206920"
  
  Dim sh1 As String, sh2 As String, sh3 As String  
  sh1 = "入力シート"
  sh2 = "店名リスト"
  sh3 = "直近検査結果表"
  
  Sheets(Array(sh2, sh3)).Select    '2シート削除
    ActiveWindow.SelectedSheets.Delete
    Sheets(sh1).Select
    Range("C7").Select

  ActiveSheet.Protect Password:="69206920", DrawingObjects:=False, _
     Contents:=True, Scenarios:= True, _
     AllowFormattingCells:=True, AllowDeletingRows:=True
  ActiveSheet.EnableSelection = xlNoRestrictions
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True  
End Sub

132 hits

【62094】マクロ実行後の「名前を付けて保存」をキャンセル まき子 09/6/22(月) 14:18 質問
【62096】Re:マクロ実行後の「名前を付けて保存」を... neptune 09/6/22(月) 15:16 回答
【62097】Re:マクロ実行後の「名前を付けて保存」を... つん 09/6/22(月) 15:17 回答
【62101】Re:マクロ実行後の「名前を付けて保存」を... まき子 09/6/22(月) 16:49 お礼

20063 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free