Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
新しいブックへコピー
投稿日時: 19/06/22 16:09:13
投稿者: 里美

ExcelのVBA初心者で挑戦中です。
宜しくお願い致します。
 
説明も不十分で申し訳ありません。
 
 
シート名「管理表」を新しいブックへコピーし
名前を付けて保存出来る様と考えています。
シートは他にもありますが、「管理表」だけ
新しいブックへコピーし名前を付けて保存を行いたい
と考えています。
お力添えをお願い致します
 
保存先については、
デスクトップのフォルダー名:管理 へ
保存を考えています。
 
新しいブック(Excel)名前については、
固定で「管理表」と考えています。
 
宜しくお願い致します。

回答
投稿日時: 19/06/22 16:33:31
投稿者: mattuwan44

>宜しくお願い致します。
 
エクセルでは操作をVBAのコードで記録してくれる機能があります。
その機能で操作が、VBAではどのような命令になるかを知ることができます。
 
まずは、それを試してみてください。
 
参考URL>>
 
https://www.fastclassinfo.com/entry/macro_jido_kiroku

回答
投稿日時: 19/06/22 16:38:38
投稿者: mattuwan44

http://www.ken3.org/vba/excel-help.html
 
細切れですみません。
↑も参考になると思います。
 

回答
投稿日時: 19/06/22 16:41:40
投稿者: WinArrow
投稿者のウェブサイトに移動

アドバイス
 
現在、考えている範囲のコードが作成できてから、カスタマイズする時に
考えればよいのですが・・・・・
 
その1
複数のブックを取り扱う場合、
データブックとマクロブックを別に作成することをお勧めします。
 
 
その2
これから保存(多分、「名前を受けて保存」になると面ますが)
指定のフォルダ内に同名のファイルが存在した場合、
どのようにするかを考えておいた方がよいです。

投稿日時: 19/06/22 17:27:52
投稿者: 里美

皆様
ありがとうございます。
エクセルでは操作をVBAのコードで記録してくれる機能で
一度、試して報告します。
 
WinArrow さんの
その2
これから保存(多分、「名前を受けて保存」になると面ますが)
 指定のフォルダ内に同名のファイルが存在した場合、
どのようにするかを考えておいた方がよいです。
→よく、理解できませんでした。
 取り急ぎ、報告いたします。
 

投稿日時: 19/06/22 18:18:17
投稿者: 里美

Sub 新しいブックへコピー()
 
    Sheets("管理表").Select
    Sheets("管理表").Copy
    ChDir "C:\Users\Y_Higuchi\Desktop\管理"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Y_SATOMI\Desktop\管理\管理表.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub
上記にて、問題なくできました。
ありがとうございます。
ここで、質問です。
1.C:\Users\Y_SATOMI\Desktop
ですが他のPCのデスクトップのフォルダー名:管理へ保存する場合はどの様にしたら
良いでしょうか?
 
2.今後、シートの保護とブックの保護も行いたいのですが
大丈夫ですか?
 
宜しくお願い致します。

回答
投稿日時: 19/06/22 19:36:49
投稿者: mattuwan44

>上記にて、問題なくできました。
 
そのコードを2回目に実行したら、1回目に出来たファイルに
上書きになると思いますが、それでよいのでしょうか?
 
>他のPCのデスクトップのフォルダー名:管理へ保存する場合はどの様にしたら
>良いでしょうか?
また、マクロの記録をしたら解るんじゃないでしょうか?
 
>今後、シートの保護とブックの保護も行いたいのですが
>大丈夫ですか?
やってみたらいかがでしょうか?
不都合があれば、それから聞けばいい話です。
 
新しいことにチャレンジして、
アップアップしているのは解りますが、
自分で探る力を付けましょう。
結果を急がず、落ち着いて考えてみましょう。
質問に質問で返しているのは、ご自分で考えて欲しいからです。
あと、ご自分でWebなどで、調べてみることも、お勧めします。
 
 

回答
投稿日時: 19/06/22 19:47:11
投稿者: WinArrow
投稿者のウェブサイトに移動

文章の7入力ミスがありました。
>これから保存(多分、「名前を受けて保存」になると面ますが)
正しくは↓
これから保存(多分、「名前をつけて保存」になると思いますが)
 
 
mattuwan44 さんレスに書かれていますが、
 
出来上がったコードを再度実行してみてください。
 
デスクトップに同名のファイルができていますよね?
「上書きしますか?」って聞いてきますよね?
 
それで、操作性は問題ありませんか?
 

回答
投稿日時: 19/06/22 20:06:42
投稿者: WinArrow
投稿者のウェブサイトに移動

>シートの保護とブックの保護
について
 
どのような理由、背景でこの機能を追加するのか?
わかりませんが、
おそらく、中身を変更されたら困る・・・・というような理由だとしたら、
例えば、誤って、ファイルを削除してしまうとか、別の場所に移動するとか、
これらには、対処しなくてよいのですか?
 

投稿日時: 19/06/22 20:46:32
投稿者: 里美

色々と、一気に出来ないのが、現状です。
 
〉mattuwan44さんのコメント
〉そのコードを2回目に実行したら、1回目に出来たファイルに
〉上書きになると思いますが、それでよいのでしょうか?
→困ります。
これについては、希望は 別シート、シート名:日程表
の セルのK5とK6をファイル名に
したいのですが、
 例)
シート名:入力画面セル K5に 2019
シート名:入力画面セル K6に 6
と記載がありますので、
 
2019_6月分管理表
としたいです。
ネットで調べても解りませんでした。
宜しくお願い致します。
  
>>他のPCのデスクトップのフォルダー名:管理へ保存する場合はどの様にしたら
>>良いでしょうか?
>また、マクロの記録をしたら解るんじゃないでしょうか?
→他のPCの事を自分のCPでわかるんですか?
C:\Users\Y_SATOMI\Desktop
「SATOMI」の部分は私のPCで 他のPCでは、別の名前になりますよね
>また、マクロの記録をしたら解るんじゃないでしょうか?
→理解が出来ません。
 
宜しくお願い致します。

回答
投稿日時: 19/06/22 21:20:53
投稿者: WinArrow
投稿者のウェブサイトに移動

デスクトップのフォルダ名を取得するコード例
→このコードは、マクロの記録では取得できません。
 
Dim DESKTOPPATH As String
    With CreateObject("WScript.shell")
        DESKTOPPATH = .SpecialFolders("Desktop") & "\管理"
    End With
    ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\管理表.xlsx"
 
文字列型の変数を用意して、「値」を入れます。
 
一応、ここまで、
 
ファイル名も、同じ考え方で、編集してみましょう。

投稿日時: 19/06/22 21:45:01
投稿者: 里美

WinArrow さんコメント
>文字列型の変数を用意して、「値」を入れます。
→申し訳ありません、わかりませんので
お教え下さい。
 
別シート、シート名:日程表
の セルのK5とK6をファイル名に
 したいのですが、
 例)
シート名:入力画面セル K5に 2019
シート名:入力画面セル K6に 6
と記載がありますので、
  
2019_6月分管理表

回答
投稿日時: 19/06/22 22:03:37
投稿者: mattuwan44

>他のPCでは、別の名前になりますよね
あぁ、LANで他のPCに保存するのかと思いました。失礼しました。
他人に配布して使ってもらおうということですね。
 
既にコードが提示されていますが、
http://officetanaka.net/excel/vba/tips/tips107.htm
↑が参考になるかと思います。
 
また、マクロがあるファイルと同じフォルダに入れるという事なら、
 
ThisWorkbook.Path
 
で、自ファイルのパスの文字列が取得できますので、
その文字列を加工してもよいかと思います。
 
参考URL>>
https://www.officepro.jp/excelvba/basic/index7.html
 
あと、他人に配布して使ってもらおうということなら、
http://www.asahi-net.or.jp/~ef2o-inue/haifu/sub06_010.html
ここを一読されたほうがよいかと思います。
 
他人に使ってもらうマクロを作るのは結構むずいです。
自分だけなら、不具合が出たときにその都度強引にでも結果が出せると思いますが、
配布するとなると、想定外の操作で想定外の結果が出るたびに呼ばれます><
 
https://vbae.odyssey-com.co.jp/column/
↑が参考になるかと思いますが、このような環境で開発が出来る人は恵まれてますよね^^;
 

回答
投稿日時: 19/06/22 22:06:27
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
別シート、シート名:日程表
の セルのK5とK6をファイル名に
 したいのですが

 
セルも一種の変数ととらえることができます。
固定値は、"で括ってつなげることができます。
 
 
ヒント
Dim 年 As String
 
年 = "2019"
 
Debug.Print 年 & "年"
 
※年という変数を、セルに変更すればよいです。

Debug.Print Sheets("日程").Range("K5").Value & "年"
 

回答
投稿日時: 19/06/22 22:14:45
投稿者: mattuwan44

>ExcelのVBA初心者で挑戦中です。
ということなら、入門書とか購入されて勉強されているのですかね?
もし、購入されていないのなら、
マクロの記録だけでマクロを作ろうというのは無謀です。
 
まずは、今やりたいことと並行し
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html
↑の1〜8までをしっかり読んで理解されることをお勧めします。
 
あと、
http://officetanaka.net/excel/vba/
https://www.relief.jp/Excel-VBA/
http://www.asahi-net.or.jp/~ef2o-inue/menu/menu04.html
http://home.att.ne.jp/zeta/gen/excel/c03p01.htm
この辺を中心に(他にもたくさん解説サイトがあります)、
情報を漁ってください。

投稿日時: 19/06/23 11:23:22
投稿者: 里美

皆様 ありがとうございます。
 色々サイトも調べて、作成してみました。
 下記の様に作成ですが、新しいブックが開いたままです。
エラーになります。
ご指導ください。
  
   
Sub 新しいブックへコピー()
Dim DESKTOPPATH As String
      With CreateObject("WScript.shell")
          DESKTOPPATH = .SpecialFolders("Desktop") & "\管理"
      End With
              
        
        
      Dim file As String
 file = Sheets("入力画面").Range("K5").Value & "_" & Sheets("入力画面").Range("K6") & "月分管理表.xls"
 Application.DisplayAlerts = False
 Sheets("管理表").COPY
 ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file
 Application.DisplayAlerts = True
        
 End Sub

回答
投稿日時: 19/06/23 14:30:37
投稿者: mattuwan44

>エラーになります。
エラーが出るときは、
どの行で、どのようなエラーメッセージが出るかを教えてください。
 
また、エラーメッセージをそのまま書き写して検索すると、
大抵は原因と解決策がわかるはずです。
 
>新しいブックが開いたままです。
「○○ブックを閉じる。」という命令がないので、
当然、開いたままでしょうね。
その一文を追加しましょう。
 
命令は、マクロの記録で調べるか、ネットで検索してみればわかると思います。

投稿日時: 19/06/26 22:15:31
投稿者: 里美

mattuwan44 さんの引用:
>命令は、マクロの記録で調べるか、ネットで検索してみればわかると思います。

文句を 言うつもりではないですが…
ここのサイトは本当に、噂通りです。
数名が、かき乱していると…
本当でしたね
 
ネットで検索して、理解出来れ、苦労しません。
 
ここのサイトは性格が悪いです。

回答
投稿日時: 19/06/26 23:02:12
投稿者: WinArrow
投稿者のウェブサイトに移動

貴方の
投稿日時: 19/06/22 18:18:17
の投稿時のコード

引用:
ActiveWorkbook.SaveAs Filename:="C:\Users\Y_SATOMI\Desktop\管理\管理表.xlsx", _
         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
     ActiveWindow.Close


 
投稿日時: 19/06/23 11:23:22
のコード
 
引用:
file = Sheets("入力画面").Range("K5").Value & "_" & Sheets("入力画面").Range("K6") & "月分管理表.xls"
  Application.DisplayAlerts = False
  Sheets("管理表").COPY
  ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file
  Application.DisplayAlerts = True
     

と比べてみましょう。
 
いくつかの違いがあります。
 
ファイルのフルパスの編集方法
ファイル名の中にセルの値を組み込んだところは、1つ進歩しました。(スキルアップ)
でも、拡張子が「前者は、xlsx」に対して「後者は、xls」になっています。
 
ファイル保存の命令について
前者には、ファイル形式の指定があるが、後者には、ファイル形式をしていしていない。
 
ファイルクローズにういて
前者には、ファイルクロースがあるが、後者には、ファイルクローズがない。
 
というように、うまくいっているコードと、うまくいかないコードの違いを
分析することも勉強しましょう。
 
 
ついでに、書いておきますが、
拡張子:xlsでファイル保存する場合、
後者の命令で保存したファイルは開けません。
拡張子とファイル形式の整合が取れていないためです。
コードを記述するとき、省略してもよい項目がありますが、省略するとデフォルトといって
ExcelVBAが補ってくれます。
でも他の設定値と整合が取れていない(つまり、コード記述する人はわかっているものと判断している)
ことから、このようなことが起こりうるのです。
 
そのあたりはHELPをみて、確認することをお勧めします。
 
拡張子:xlsは、Excel 97-2003 形式です。
FileFormatは、Excel2017以降では、Excel8形式を指定して保存しないと正常には開けません。
 
 
 
 
 

回答
投稿日時: 19/06/26 23:08:52
投稿者: WinArrow
投稿者のウェブサイトに移動

文章の入力ミスを訂正します。
 
>FileFormatは、Excel2017以降では、Excel8形式を指定して保存しないと正常には開けません。

FileFormatは、Excel2007以降では、Excel8形式を指定して保存しないと正常には開けません。

回答
投稿日時: 19/06/27 07:40:06
投稿者: simple

ブックを閉じる について
■マクロ記録による方法
Sheet1を新規ブックにコピーして、保存して、閉じる動作のマクロ記録です。

Sub Macro1()
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy
    ActiveWorkbook.SaveAs Filename:="D:\○○\testA.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close
End Sub

■検索による方法
「ExcelVBA ブックを閉じる」でGoogle検索すると、
「ブックを閉じる」
http://officetanaka.net/excel/vba/file/file03.htm
が最初に表示されます。
引用:
ブックを閉じるには、WorkbookオブジェクトのCloseメソッドを使います。
次のコードは、すでに開いている Book1.xlsx を閉じます。
Sub Sample1()
    Workbooks("Book1.xlsx").Close
End Sub
といった記述があります。
 
いずれにしても、ブックオブジェクト.Close
でいいんだなと察しがつきませんか?
余り混乱するような難しい話でもなさそうですよ。
 
--------------------
>命令は、マクロの記録で調べるか、ネットで検索してみればわかると思います。
きちんと負荷がどの程度かを推定して助言されていると思いますよ。
 
希望を言って、すぐにコードが出てくるというスタイルよりも、
トライの仕方も含めて助言があるほうが、私は有益だと思いますけど。
簡単に入手でき、結果オーライで過ごしていくと、
そのうち自分で理解していることとそうでないことの見分けがつかなくなってきます。
それよりも自分の足でしっかり前に進める力をつけたほうがよいと私は思います。
それがVBAを使えるようになるということかと思います。
いやいやそんなことは目指していない、というなら別ですけど、
少しだけお考えを変えたほうがいいと思いますよ。

投稿日時: 19/06/27 17:16:12
投稿者: 里美

皆様、本当にありがとうございます。
あれから、色んなサイトを見て
下記の様に作成してみました。
まだ、理解不十分な点が多くありますので、宜しくお願い致します。  
 
このコードも、HPからのCOPYです。100%理解とは言えません。
 
 
1点、何度やっても、旨く行かない点があります。
ので、宜しくお願い致します。
 
新しいブック作成中
新しいブックが開いたまま処理です。
最後のメッセージの
「デスクトップ_管理\管理表履歴へ出力しました。」の
時も、新しいブックが開いたままの状態です。
 
閉じて、処理は不可能ですか。
 
 
再三のお願いですが、まだ初心なので具体的に、ご指導の程、
宜しくお願い致します。
 
 
 
 
Sub Excel出力()
Dim Result As Long
 Result = MsgBox(" Excel出力をしますか?", vbYesNo + vbQuestion, " Excel出力確認")
     
    If Result = vbYes Then
 
 ''[はい]がクリックされたときの処理
 
 Dim DESKTOPPATH As String
 With CreateObject("WScript.shell")
 DESKTOPPATH = .SpecialFolders("Desktop") & "\管理\管理表履歴"
End With
 Dim file As String
 file = Sheets("入力画面").Range("K5").Value & "_" & Sheets("入力画面").Range("K6") & "月分管理表.xlsx"
 Sheets("管理表").Copy
 ActiveSheet.Unprotect "123" 'パスワードの解除
 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
  
 '削除
  Range("A:B").Delete ' A 〜 B 列を削除
  Range("1:9").Delete ' 1 〜 9 行目を削除
   
  'グループ化 解除
  ActiveSheet.Cells.ClearOutline
  
 '列挿入
 Columns("A").Insert ' A 列に挿入
   Columns("A").ColumnWidth = 3
    
    '列の非表示
   Columns("B").Hidden = True 'を入力します。
    
   '高さ
   Rows("1").RowHeight = 18
    
   'シート名
   Sheets(1).Name = "管理表"
    
    
   '新しいブックのパス設定
   ActiveSheet.Protect Password:="1234"
   Range("a1").Select
    
  
 
  Result = MsgBox("デスクトップ_管理\管理表履歴へ出力しました。", vbOKOnly + vbInformation, " Excel出力確認")
   
 Application.DisplayAlerts = False
 ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
 Application.DisplayAlerts = True
 ActiveWorkbook.Close False
 Range("a1").Select '’’’'位置
  Else
   
   
  ''[いいえ]がクリックされたときの処理
         
  Result = MsgBox("処理を中止しました。", vbOKOnly + vbCritical, " Excel出力確認")
    End If
End Sub

回答
投稿日時: 19/06/27 18:33:28
投稿者: 半平太

>閉じて、処理は不可能ですか。
 
「いつ」閉じて、「何の」処理をする話ですか?

回答
投稿日時: 19/06/27 19:08:08
投稿者: WinArrow
投稿者のウェブサイトに移動

コードをみたかぎりでは、
新しいブックが開いたまま
という状況にはならないと思います。
 
掲示のコード以外に(そのマクロ実行前に)
新しいブックをsく制しているような気がします。
 
 
コード毎にコメントを入れて
コードそのものを理解しようとしているのは
とても良いことです。
 
しかし、コードの見やすくするには、
インデントをつけることです。
 
インデントをつけたコードを下記します。
セルを参照する際、どのブックのどのシートなのかを明示的に機銃ツする方法も含まれています。
 
Sub Excel出力()
Dim Result As Long
Dim DESKTOPPATH As String
Dim file As String
 
Dim wbk As Workbook
'実行前に開いているブックをイミディトウインドウい表示しる
    For Each wbk In Workbooks
        Debug.Print wbk.Name
    Next
   
    Result = MsgBox(" Excel出力をしますか?", vbYesNo + vbQuestion, " Excel出力確認")
       
    If Result = vbYes Then
   
  ''[はい]がクリックされたときの処理
  
        With CreateObject("WScript.shell")
            DESKTOPPATH = .SpecialFolders("Desktop") & "\管理\管理表履歴"
        End With
        With ThisWorkbook
            With .Sheets("入力画面")
                file = .Range("K5").Value & "_" & .Range("K6") & "月分管理表.xlsx"
            End With
            .Sheets("管理表").Copy
        End With
         
        With ActiveWorkbook
            With .Sheets(1)
                .Unprotect "123" 'パスワードの解除
                .UsedRange.Value = .UsedRange.Value
    
  '削除
                .Range("A:B").Delete ' A 〜 B 列を削除
                .Range("1:9").Delete ' 1 〜 9 行目を削除
    
   'グループ化 解除
                .Cells.ClearOutline
    
  '列挿入
                .Columns("A").Insert ' A 列に挿入
                .Columns("A").ColumnWidth = 3
      
'列の非表示
                .Columns("B").Hidden = True 'を入力します。
     
    '高さ
                .Rows("1").RowHeight = 18
      
    'シート名
                .Name = "管理表"
      
      
    '新しいブックのパス設定
                .Protect Password:="1234"
                .Range("a1").Select
            End With
   
            Result = MsgBox("デスクトップ_管理\管理表履歴へ出力しました。", vbOKOnly + vbInformation, " Excel出力確認")
     
            Application.DisplayAlerts = False
            .SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            .Close False
        End With
    Else
     
     
   ''[いいえ]がクリックされたときの処理
          
        Result = MsgBox("処理を中止しました。", vbOKOnly + vbCritical, " Excel出力確認")
    End If
End Sub
 
 
自分が考えたように実行されるかを目視で確認する方法があります。
それは、ステップ実行です。
 
「F8」を押して、1ステップづつ実行していきます。
その際、変数の値を確認することができるので
間違った値がセットされているかがわかります。
 
 
 

回答
投稿日時: 19/06/27 19:30:57
投稿者: mattuwan44

>最後のメッセージの
>「デスクトップ_管理\管理表履歴へ出力しました。」の
>時も、新しいブックが開いたままの状態です。

 
http://www.ken3.org/vba/excel-help.html
 
↑を見て、
プロシージャの先頭にブレークポイントを置いて、
自動で次々実行されるのを止め、
「F8」キー押下で、1行毎に実行してみて、画面と見比べながら、
どのタイミングで、「ブックを閉じる」の命令が実行されるように書いたかを、
確認してみてください。
上級者でも、一発でエラーの無い、そして間違いのないコードを書くことは、
結構難しいです。
なので、どこが間違っているかを探す方法も覚える必要があります。
 

引用:
ネットで検索して、理解出来れ、苦労しません。

いずれは、ご自分でマクロを作れるように出来るようになりたいのでしょうから、
マクロの記録やVBAのヘルプあるいはネット上で検索して、
必要な情報を調べられるようになることは必須だと思います。
これは、初心者だけではなく、上級者もやっていることです。
なので、苦労や努力は避けて通れないと思いますが、いかがでしょうか?
なにも、ネットで調べてすべてを理解しろとは言ってません。
まずは、自分で調べてみる。
でも、いい情報を探せなかった。あるいは、理解が出来なかった。
あるいは、ネットで調べてこんな風に書いてみたけど、
期待する動作にならなかった。
そういう努力をしたなら、そう書いてください。

回答
投稿日時: 19/06/27 19:51:42
投稿者: WinArrow
投稿者のウェブサイトに移動

文章の訂正です。
 
>セルを参照する際、どのブックのどのシートなのかを明示的に機銃ツする方法も含まれています。
  

 
セルを参照する際、どのブックのどのシートなのかを明示的に記述する方法も含まれています。
  
 
※反省\・・・入力ミスが多くてごめんなさい。

投稿日時: 19/06/27 22:05:24
投稿者: 里美

WinArrow さん
ご丁寧に、本当にありがとうございます。 助かります。
WinArrow の修正コード スッキリで見やすいです。
流石です。。。。
「file = .Range("H7).Value & "_" & .Range("H8") & "月分管理表.xlsx" 」
→ここはエラーの為修正致しました。
 
で、最初の質問は
新しいブックへのCOPY作業が見えた状態
開いた状態です。これは当然ですか?
 
それと、出来れば、WinArrow さんが最初に言っていた
ファイル内 管理\管理表履歴に同じ 名前のファイルがある場合
 
XX月分管理表.xlsxは既に存在します。
上書きしますか?
はい いいえ
 
「はい」の場合は
→出力しました
 
「いいえ」
→処理を中止しました。
に変更したいのですが
 
宜しくお願い致します。
 
  

回答
投稿日時: 19/06/27 22:34:30
投稿者: simple

こんばんは。
 
ひとつずつ課題に取り組んでください。
最初に、ファイルを閉じるタイミングの問題。
 
まず、現在のコードでは、

    ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
    (--  一行省略 --)
    ActiveWorkbook.Close False
と、
・保存した後で
・そのブックをキチンと閉じていますね。
その認識は、あなたと共有できていますか?
 
そして、あなたの希望はどうすることですか?
保存する前に閉じたいのですか?
それ無理ですよ?
そう思いませんか?
 
非表示にしたいということですか?

投稿日時: 19/06/27 22:59:33
投稿者: 里美

申し訳ございません。
 
>非表示にしたいということですか?
→その通りです。
 
宜しくお願い致します。
 

回答
投稿日時: 19/06/27 23:05:48
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

XX月分管理表.xlsxは既に存在します。
 上書きしますか?
はい いいえ
  
「はい」の場合は
→出力しました
  
「いいえ」
→処理を中止しました。
に変更したいのですが

 
なるほど・・・
↓のコードは、どのような目的で記述したんですか?
> Application.DisplayAlerts = False
 
この命令は、同名のファイルが素材した場合、
「上書き保存しますかますか?」
というメッセージを表示させない命令です。
従って、無条件で上書きされてしまいます。
 
 
同名ファイルの存在有無を判断方法(いくつか方法があるが、その一つ)
 
If Dir(file) <> "" Then
  ’ファイルあり
Else
    'ファイル無
End If
 
だから、
> Application.DisplayAlerts = False
は不要です。
 

回答
投稿日時: 19/06/27 23:10:25
投稿者: mattuwan44

とりあえず、サンプル書いてみました。
 

Option Explicit

Sub サンプル()
    Dim strPrompt As String
    Dim lngButtons As Long
    Dim strTitle As String
    Dim DesktopPath As String
    Dim myDirectoryPath As String
    Dim myFileName As String

    strPrompt = "Excel出力をしますか?"
    lngButtons = vbYesNo + vbQuestion
    strTitle = "Excel出力確認"

    If MsgBox(strPrompt, lngButtons, strTitle) = vbYes Then
        'デスクトップのパスの取得
        DesktopPath = CreateObject("WScript.shell").SpecialFolders("Desktop")
        '指定のフォルダの存在確認(もしなければ作成する)
        If Dir(.SpecialFolders("Desktop") & "\管理", vbDirectory) = "" Then
            MkDir .SpecialFolders("Desktop") & "\管理"
        End If
        If Dir(.SpecialFolders("Desktop") & "\管理\管理表履歴", vbDirectory) = "" Then
            MkDir .SpecialFolders("Desktop") & "\管理\管理表履歴"
        End If
        '保存するフォルダのパスの取得
        myDirectoryPath = DesktopPath & "\管理\管理表履歴"
        
        '保存するファイルの名前の取得
        With ThisWorkbook.Sheets("入力画面")
            myFileName = .Range("K5").Value & "_" & .Range("K6") & "月分管理表.xlsx"
        End With
        '管理表シートのコピーを加工して新しいブックとして保存
        SetNewBook ThisWorkbook.Sheets("管理表"), myDirectoryPath, myFileName
        'メッセージボックスの表示の用意
        strPrompt = "デスクトップ_管理\管理表履歴へ出力しました。" _
                    & vbLf & myFileName
        lngButtons = vbOKOnly + vbInformation
    Else
        strPrompt = "処理を中止しました。"
        lngButtons = vbOKOnly + vbCritical
    End If

    MsgBox strPrompt, lngButtons, strTitle
End Sub

'シートのコピーを加工して新しいブックとして保存
Private Function SetNewBook(ByVal wsh As Worksheet, _
                            ByVal sPath As String, _
                            ByVal sName As String) As String
    wsh.Copy
    With Workbooks(Workbooks.Count)
        With .Sheets(1)
            .Unprotect "123"                    'シートの保護の解除
            With .UsedRange
                .ClearOutline                   'グループ化解除
                .Value = .Value                 '数式を値に変換
                .Columns("A").Insert            'A列の前に列挿入
                .Columns("A").EntireColumn.ColumnWidth = 3  '列幅を変更
                .Columns("B").EntireColumn.Hidden = True    '列を非表示
                .Rows("1").EntireRow.RowHeight = 18         '行高を変更
                .Range("A1").Select
            End With
            .Protect Password:="1234"           'シートの保護
        End With
        .Close Filename:=sPath & "\" & sName
    End With
End Function

動作確認してません。上手く動かなかったらごめんなさいです。
フォルダの存在確認の流れが不細工ですが、ぱっと思いつかなかったので、いい加減です。
今後の研究課題として研究するなり別途質問するなりしてみてください。
参考になれば。。。。。

回答
投稿日時: 19/06/27 23:47:00
投稿者: simple

【ファイルを閉じる話です】
相変わらず依頼型なんですね。マクロ記録すればわかりますけど。
ActiveWindow.Visible = False
で非表示にはなりますが、問題がありますね。
 
シートをコピーしたあとに非表示にすると、

ActiveSheet.Unprotect "123" 'パスワードの解除 
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 
Range("A:B").Delete ' A 〜 B 列を削除 
Range("1:9").Delete ' 1 〜 9 行目を削除 
などの処理は、(表示されている)コピー元のシートを対象に実行されてしまいますね。
 
そもそも非表示にする必要が本当にありますか?
そのマクロ処理は一瞬じゃないですか。
処理が終わった段階で閉じられていれば問題ないと思います。
ユーザーはその間、それに対して間違った処理をしてしまうリスクもありません。
再考したほうがよいと思います。
不要なことに労力を使わない方がよいです。
 
作業自体を見せたくないということなら、
むしろ、マクロ期間中に画面更新を抑止する方向で考えたほうがよいと思います。
(Application.ScreenUpdating = False
  といったコードを見たことありませんか?)
 
私はこの辺で失礼します。

回答
投稿日時: 19/06/27 23:49:30
投稿者: WinArrow
投稿者のウェブサイトに移動

飲んどもすみません。
文章の訂正です。
 

引用:
なるほど・・・
↓のコードは、どのような目的で記述したんですか?
> Application.DisplayAlerts = False
   
この命令は、同名のファイルが素材した場合、
 「上書き保存しますかますか?」
というメッセージを表示させない命令です。
 従って、無条件で上書きされてしまいます。
 


なるほど・・・
↓のコードは、どのような目的で記述したんですか?
> Application.DisplayAlerts = False
   
この命令は、同名のファイルが存在した場合、
 「上書き保存しますか?
というメッセージを表示させない命令です。
従って、無条件で上書きされてしまいます。
  
 
同名のファイル存在チェックのコード例(ヒント)
 
    有無 = False
     
    If Dir(File) <> "" Then
        If vbYes = MsgBox("同名のファイルが存在します。保存せずに終了しますか?", vbYesNo) Then
            有無 = True
        End If
    End If
    If 有無 = False Then
        ThisWorkbook.SaveAs Filename:=File
    End If
 

回答
投稿日時: 19/06/28 08:00:47
投稿者: WinArrow
投稿者のウェブサイトに移動

前レスのヒントのコードを↓に差し替えてください。
 
Dim 有無 As Integer
     
    有無 = 0
       
    If Dir(file) <> "" Then
        If vbYes = MsgBox("同名のファイルが存在します。" & vbLf & _
                    "上書き保存しますか?", vbYesNo) Then
            有無 = 1
        Else
            有無 = 2
        End If
     End If
     If 有無 <> 2 Then
        If 有無 = 1 Then Kill file
         ActiveWorkbook.SaveAs Filename:=file
     End If

回答
投稿日時: 19/06/28 09:21:39
投稿者: simple

【ファイルを閉じる話(続き、これで終わり)】

引用:
最後のメッセージの
「デスクトップ_管理\管理表履歴へ出力しました。」の
時も、新しいブックが開いたままの状態です。
閉じて、処理は不可能ですか。
それはメッセージを出すタイミングが間違っているだけです。
保存処理する前に「出力しました」は無いでしょう。
余計なタイミングでMsgBoxを出すから、開いたままとかの
感想が出てくるのです。
(そもそもそういう警告の類は、骨格となる部分が完成してから足せばよいのです。)
 
一度、ステップ実行をしてみて、処理の流れを自分の身体で確認して下さい。
頭でっかちになっているんじゃないかと思います。

回答
投稿日時: 19/06/28 10:04:25
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

それはメッセージを出すタイミングが間違っているだけです。
 保存処理する前に「出力しました」は無いでしょう。
 余計なタイミングでMsgBoxを出すから、開いたままとかの
感想が出てくるのです。
 

 
そういう話でしたか?
私も、閉じる前に過去形のメッセージには、違和感を持っていましたが、
てっきり、わかっているものと思っていました。
まあ、オペレータが、おかしいと感じるかどうかはわかりませんが、
「お風呂に入ってから衣服を脱ぐ」
ようなことにしないといけませんね?
 
 

投稿日時: 19/06/28 10:21:10
投稿者: 里美

WinArrow さん
ありがとうございます。
色々と試しました。
まだ、ダメです。
下記 
 
旨く出来ません。
 
お教え下さい。
 
 
:
:
~~~
'新しいブックのパス設定
                .Protect Password:="1234"
                 .Range("a1").Select
             End With
※↑後に 追加しました…
 
 If Dir(DESKTOPPATH & "\" & file) = "" Then
  ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
  ActiveWorkbook.Close '閉じる
  Result = MsgBox("デスクトップ_管理\管理表履歴へ出力しました。", vbOKOnly + vbInformation, " Excel出力確認")
   
 Else
 
 
 If MsgBox(DESKTOPPATH & "\" & file & "は既に存在します。" & vbCrLf & "上書しますか?", vbYesNo + vbExclamation, "確認") = vbYes Then
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
  
   
  
  Result = MsgBox("出力しました。", vbOKOnly + vbInformation, " Excel出力確認")
 Application.DisplayAlerts = True
  Else
 Result = MsgBox("処理を中止しました。", vbOKOnly + vbCritical, " Excel出力確認")
  
 Exit Sub
  End If
  End If

回答
投稿日時: 19/06/28 11:17:14
投稿者: WinArrow
投稿者のウェブサイトに移動

ダメ
とか
うまくいきません
とか
目に見えない形で、書いてもらっても
アドバイスできませんよ!
何しろ回答者には、貴方のPCの画面は見えませんから・・・
 
 
現状をきちんと目に見えるような形で伝えなることも大切なことです。

回答
投稿日時: 19/06/28 16:02:24
投稿者: Nao

こんにちは。横から失礼いたします。
 
MsgBoxの使い方(位置)で苦労されているようですね。
わかりやすいように、最初に処理をするのか、中断するのかを確認してみたらいかがですか?
 
「出力しますか?」で「いいえ」だったらそこで処理を中止する。(Exit Sub)
「上書きしますか?」で「いいえ」だったらそこで処理を中止する。(Exit Sub)
 
で、最後の最後に処理が終わったメッセージを出してみた方がわかり易いと思いますよ。
 

Sub Excel出力()

Dim DesktopPath As String
Dim file As String
    
    '出力処理をするか確認する
    If MsgBox(" Excel出力をしますか?", vbYesNo + vbQuestion, "Excel出力確認") = vbNo Then
        '「いいえ」ボタンが押されたらメッセージを出して処理を中止する
        MsgBox "処理を中止しました。", vbOKOnly + vbCritical, "Excel出力確認"
        Exit Sub
    End If
        
    DesktopPath = CreateObject("WScript.shell").SpecialFolders("Desktop") & _
                  "\管理\管理表履歴"
    
    file = Sheets("入力画面").Range("K5").Value & "_" & _
               Sheets("入力画面").Range("K6") & "月分管理表.xlsx"
    
    '出力ファイルと同名のファイルが存在した場合
    If Dir(DesktopPath & "\" & file) <> "" Then
        '上書きを行うかの確認をする
        If MsgBox(file & "は既に存在します。" & vbNewLine & vbNewLine & _
                  "上書きしますか?", vbYesNo + vbQuestion, "Excel出力確認") = vbNo Then
            '「いいえ」ボタンが押されたらメッセージを出して処理を中止する
            MsgBox "処理を中止しました。", vbOKOnly + vbCritical, "Excel出力確認"
            Exit Sub
        End If
    End If
    
    '画面の更新を停止する
    Application.ScreenUpdating = False
    Sheets("管理表").Copy
    ActiveSheet.Unprotect "123" 'パスワードの解除
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    
    ・
    ・
    ・
    ・

    '新しいブックのパス設定
    ActiveSheet.Protect Password:="1234"
    Range("A1").Select
    
    '確認メッセージを非表示にする
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=DesktopPath & "\" & file, FileFormat:=xlOpenXMLWorkbook
    '確認メッセージを表示に戻す
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
    '画面の更新を再開する
    Application.ScreenUpdating = True
    
    Range("A1").Select '’’’'位置
    MsgBox "デスクトップ_管理\管理表履歴へ出力しました。", _
                         vbOKOnly + vbInformation, "Excel出力確認"
 End Sub

回答
投稿日時: 19/06/29 11:21:05
投稿者: simple

まずは、現在のコードを
・省略せずに最初から最後まで、
・インデントをキチンとつけて
こちらに示し、
問題点を箇条書きにする
ことから始めてはどうですか?
 
上達に必要なプロセスを駆け足で進んでいるので、
そうそう簡単にはできない、しかしここを超えられれば先が見えてくる、
そういう局面だと思います。
ですから、時間を掛けて辛抱強く取り組む必要があります。
 
インデントの重要性を理解して賞賛されたのであれば、
早速自分もそれを見習ってはどうでしょうか。
他人が作るんじゃなくて、作るのはご自分ですから、
それが第一歩ですね。

回答
投稿日時: 19/06/29 18:21:34
投稿者: WinArrow
投稿者のウェブサイトに移動

「同名のファイルが存在した場合の対応」
は、最初の仕様では、考慮してなかったことですよね?
 
この件を除いては、意図したとおりに出来上がったのですか?
 
できた場合は、そのコードを掲示
意図した通りではない場合は、そのステップを明示して、コードを掲示
しましょう。
 
「同名のファイルが存在した場合の対応」は、そのあとで考えましょう。
 
今迄に掲示した「同名のファイルが存在した場合の対応」のコードですが、
挿入するところを間違えていると思われます。
 
落ち着いてよく考えた方がよいでしょう。
 
 
 

回答
投稿日時: 19/06/30 19:03:04
投稿者: mattuwan44

引用:
それと、出来れば、WinArrow さんが最初に言っていた
ファイル内 管理\管理表履歴に同じ 名前のファイルがある場合
  
XX月分管理表.xlsxは既に存在します。
上書きしますか?
はい いいえ
  
「はい」の場合は
→出力しました
  
「いいえ」
→処理を中止しました。
に変更したいのですが
  
宜しくお願い致します。

 
→実際保存されたか確認するよう改変しました。
ブックのSavedプロパティを見ると、最後に保存してから、編集されたかの状態が見れます。
 
引用:
最後のメッセージの
「デスクトップ_管理\管理表履歴へ出力しました。」の
時も、新しいブックが開いたままの状態です。
  
閉じて、処理は不可能ですか。

「作業中の画面がチラチラするのを抑止したい」のか、
「メッセージを出す前に、作業したファイルを閉じたい」のか、
意図が判別ができかねますが、
両方だろうということで対応してみました。
参考になれば。
 
Option Explicit

Sub サンプル()
    Dim strPrompt As String
    Dim lngButtons As Long
    Dim strTitle As String
    Dim myDirectoryPath As String
    Dim myFileName As String

    strPrompt = "Excel出力をしますか?"
    lngButtons = vbYesNo + vbQuestion
    strTitle = "Excel出力確認"

    If MsgBox(strPrompt, lngButtons, strTitle) = vbYes Then
        'デスクトップのパスの取得
        DesktopPath = CreateObject("WScript.shell").SpecialFolders("Desktop")
        '指定のフォルダの存在確認
        If Dir(.SpecialFolders("Desktop") & "\管理\管理表履歴", vbDirectory) = "" Then
            strPrompt = "指定のフォルダが見つかりません。" & vbLf & "管理者に問い合わせてください。"
            GoTo WayOut
        End If
        '保存するフォルダのパスの取得
        myDirectoryPath = CreateObject("WScript.shell").SpecialFolders("Desktop") & "\管理\管理表履歴"
        '保存するファイルの名前の取得
        With ThisWorkbook.Sheets("入力画面")
            myFileName = .Range("K5").Value & "_" & .Range("K6") & "月分管理表.xlsx"
        End With
        
        '管理表シートのコピーを加工して新しいブックとして保存
         strPrompt = SetNewBook(ThisWorkbook.Sheets("管理表"), myDirectoryPath, myFileName)
        'メッセージボックスの表示の用意
        lngButtons = vbOKOnly + vbInformation
    Else
        strPrompt = "処理を中止しました。"
        lngButtons = vbOKOnly + vbCritical
    End If

WayOut:
    MsgBox strPrompt, lngButtons, strTitle
End Sub

'シートのコピーを加工して新しいブックとして保存
Private Function SetNewBook(ByVal wsh As Worksheet, _
                            ByVal sPath As String, _
                            ByVal sName As String) As String
                            
    Application.ScreenUpdating = False  '画面の更新を止める
    wsh.Copy
    With Workbooks(Workbooks.Count)
        With .Sheets(1)
            .Unprotect "123"                    'シートの保護の解除
            With .UsedRange
                .ClearOutline                   'グループ化解除
                .Value = .Value                 '数式を値に変換
                .Columns("A").Insert            'A列の前に列挿入
                .Columns("A").EntireColumn.ColumnWidth = 3  '列幅を変更
                .Columns("B").EntireColumn.Hidden = True    '列を非表示
                .Rows("1").EntireRow.RowHeight = 18         '行高を変更
                .Range("A1").Select
            End With
            .Protect Password:="1234"           'シートの保護
        End With

        'とりあえず、名前を付けて保存してみる。
        .SaveAs sPath & "\" & sName
        'ブックへの変更が保存されたかをチェックして条件分岐
        If .Saved Then
            SetNewBook = strPrompt = "デスクトップ_管理\管理表履歴へ出力しました。" _
                         & vbLf & sName
        Else
            SetNewBook = sName & " はすでに保存済みでした。"
        End If
        .Close False
    End With
    Application.ScreenUpdating = True   '画面の更新を再開
End Function

 
参考URL「画面の更新を止める」>>
http://officetanaka.net/excel/vba/speed/s1.htm
 
今回のサンプルは、すでに同じ名前のファイルが存在する場合、
あえて、エクセル君が「上書きしますか?」と聞いてくるだろうという前提でコードを書いていますが、
実際には、保存するファイルの名前が確定した時点で、「ファイルの存在確認」が出来るので、
そこで判別して処理を分けるともっとスマートです。
(無駄にファイルをコピーして編集する手間が省略できる。)
「VBA ファイルの存在確認」で検索してみてください。
 
あと、ことさら初心者を強調されてますが、
初心者であろうと上級者であろうと、
単に「知らないこと、あるいはわからないことを聞く」というスタンスでいいのではないでしょうか?
↓参照
https://ch.nicovideo.jp/pdex001/blomaga/ar1346309
 
回答側ではあなたがどんなことをいままでやってきて、
質問に至ったかわかりません。
なので、何をやったのかも質問と合わせて説明していただけると
回答側も対応がしやすいと思います。
 
意地悪く回りくどいことを言うとお思いでしょうが、
まずは、ご自分で調べたり考えたりして、
いまどんな情報が欲しいかに気付く力を身に付けて欲しいと思いますし、
自分で調べたり試行錯誤をして探る力も身に付けて欲しいと思います。
もちろん一朝一夕で出来ることではないですが、
それが出来るようにならなければ何年たっても初心者から抜け出せないと思います。

投稿日時: 19/07/01 11:30:43
投稿者: 里美

Naoさんへ
 
ご丁寧に本当に、ありがとうございます。
問題なく、希望通りに出来ました。
 
2点お教え下さい。
 
1.
 ActiveSheet.Unprotect "123" 'パスワードの解除
 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
  の後に、
'削除
                .Range("A:B").Delete ' A 〜 B 列を削除
                .Range("1:9").Delete ' 1 〜 9 行目を削除
     
    'グループ化 解除
                .Cells.ClearOutline
      
   '列挿入
                .Columns("A").Insert ' A 列に挿入
                .Columns("A").ColumnWidth = 3
        
   '列の非表示
                .Columns("B").Hidden = True 'を入力します。
      
     '高さ
                .Rows("1").RowHeight = 18
        
     'シート名
             ' .Name = "宿日直表"
 
を追加しましたが、「コンパイル エラー」参照が不正または不完全です。」
となります。
 
2. "\管理\管理表履歴"に保存れたExcelファイルですが、開くと、
 「読み取れない内容が含まれています。このブックの内容を回復しますか?
ブックの発行元信頼場合は、[はい]クリックして下さい。
 
[はい]をクリックすると
 
「削除された機能: /xl/worksheets/sheet1.xml パーツ内のデータの入力規則」
と、表示されました。
 
色々調べましたが、解決出来ませんでした。
 
宜しくお願い致します。
  

回答
投稿日時: 19/07/01 12:59:22
投稿者: もこな2

横からですけど

里美 さんの引用:

を追加しましたが、「コンパイル エラー」参照が不正または不完全です。」
となります。
の部分、WinArrowさんのコードを参考にされているのですよね?
そうなると、
        With ActiveWorkbook
            With .Sheets(1)

↑を忘れたりしていませんか?
 
いずれにせよ、部分的に見せるよりは全体を見せて頂いた方が、原因が特定しやすいとおもいます。

投稿日時: 19/07/01 13:23:10
投稿者: 里美

引用:

もこな2さん
いずれにせよ、部分的に見せるよりは全体を見せて頂いた方が、原因が特定しやすいとおもいます。

 
ありがとうございます。
 
Sub Excel出力()
 
Dim DesktopPath As String
Dim file As String
     
    '出力処理をするか確認する
    If MsgBox(" Excel出力をしますか?", vbYesNo + vbQuestion, "Excel出力確認") = vbNo Then
        '「いいえ」ボタンが押されたらメッセージを出して処理を中止する
        MsgBox "処理を中止しました。", vbOKOnly + vbCritical, "Excel出力確認"
        Exit Sub
    End If
         
    DesktopPath = CreateObject("WScript.shell").SpecialFolders("Desktop") & _
                  "\管理\管理表履歴"
     
    file = Sheets("入力画面").Range("K5").Value & "_" & _
               Sheets("入力画面").Range("K6") & "月分管理表.xlsx"
     
    '出力ファイルと同名のファイルが存在した場合
    If Dir(DesktopPath & "\" & file) <> "" Then
        '上書きを行うかの確認をする
        If MsgBox(file & "は既に存在します。" & vbNewLine & vbNewLine & _
                  "上書きしますか?", vbYesNo + vbQuestion, "Excel出力確認") = vbNo Then
            '「いいえ」ボタンが押されたらメッセージを出して処理を中止する
            MsgBox "処理を中止しました。", vbOKOnly + vbCritical, "Excel出力確認"
            Exit Sub
        End If
    End If
     
    '画面の更新を停止する
    Application.ScreenUpdating = False
    Sheets("管理表").Copy
    ActiveSheet.Unprotect "123" 'パスワードの解除
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
     
         
    '削除
                .Range("A:B").Delete ' A 〜 B 列を削除
                .Range("1:9").Delete ' 1 〜 9 行目を削除
     
    'グループ化 解除
                .Cells.ClearOutline
      
   '列挿入
                .Columns("A").Insert ' A 列に挿入
                .Columns("A").ColumnWidth = 3
        
   '列の非表示
                .Columns("B").Hidden = True 'を入力します。
      
     '高さ
                .Rows("1").RowHeight = 18
        
     'シート名
                .Name = "管理表"
     
     
 
    '新しいブックのパス設定
    ActiveSheet.Protect Password:="1234"
    Range("A1").Select
     
    '確認メッセージを非表示にする
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=DesktopPath & "\" & file, FileFormat:=xlOpenXMLWorkbook
    '確認メッセージを表示に戻す
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
    '画面の更新を再開する
    Application.ScreenUpdating = True
     
    Range("A1").Select '’’’'位置
    MsgBox "デスクトップ_管理\管理表履歴へ出力しました。", _
                         vbOKOnly + vbInformation, "Excel出力確認"
 End Sub
 
 
 

投稿日時: 19/07/01 13:24:16
投稿者: 里美

上記、宜しくお願い致します。

回答
投稿日時: 19/07/01 16:06:49
投稿者: 虎

横から失礼しますm(_ _)m
コンパイルエラーに関しては、もこな2さんのご指摘通り、With ○○とEnd Withが抜けちゃってるからですね。
多分、With句についてあまり理解されていないのかな?と思いますので、下記のサイトを参考にしてみてください。
http://officetanaka.net/excel/vba/beginner/16.htm
 
このサイトを見れば大体理解できるかな?と思いますが、里見さんが追加されたコードなんですけど、
最初が『.(半角ピリオド)』ではじまってますよね?
これなんですけど、With ○○からEnd Withまでの間で有効で、『これを付けたコードは○○に対して行うよ』
という意味なんです。でも、『.』から始まるのに、With ○○もEnd Withもないから、『参照が不正または不完全』
となるのです。
 
ですので、追加されたコードの前に、『With ActiveSheet』と追加し、追加されたコードの後に、『End With』
と主語を補ってあげれば、コンパイルエラーに関しては解消されると思います(^^)

回答
投稿日時: 19/07/01 23:37:40
投稿者: WinArrow
投稿者のウェブサイトに移動

参考コードを掲示します。
 
(1)コードの意味、役割をきちんと覚えてください。
 1行ごとに、コメントが入れてあったので、コードを理解sる努力をしているのかな?
 と思ったが、最後の掲示を見ると、だいぶ怪しい・・・・めちゃくちゃなところがある
 
(2)インデントをつける努力をしてください。
  修正コードを掲示するたびに崩れてきている。…非常に読みにくい
 
(3)ブック、シートで修飾すること(With句のこと)
  コードを読みやすくするばかりではなく、
  微々たるものだが、処理が早くなる。
 
Option Explicit
 
Sub Excel出力()
Dim Result As Long
Dim DESKTOPPATH As String
Dim file As String
Const MSGTITLE As String = " Excel出力確認"
    
    If vbNo = MsgBox(" Excel出力をしますか?", vbYesNo + vbQuestion, MSGTITLE) Then
        MsgBox "処理を中止しました。", vbOKOnly + vbCritical, MSGTITLE
        Exit Sub
    End If
  ''[はい]がクリックされたときの処理
    DESKTOPPATH = CreateObject("WScript.shell") _
             .SpecialFolders("Desktop") & "\管理\管理表履歴"
     
    With ThisWorkbook
        With .Sheets("入力画面")
            file = .Range("K5").Value & "_" & .Range("K6") & "月分管理表.xlsx"
        End With
             
        If Dir(DESKTOPPATH & file) <> "" Then
            If vbNo = MsgBox("「" & file & "]は既に存在します。" & vbLf & vbLf & _
                   "上書きしますか?", vbYesNo + vbQuestion, MSGTITLE) Then
                MsgBox "処理を中止しました。", vbOKOnly + vbCritical, MSGTITLE
                Exit Sub
            End If
        End If
         
        .Sheets("管理表").Copy
    End With
          
    With ActiveWorkbook
        With .Sheets(1)
            .Unprotect "123" 'パスワードの解除
            .UsedRange.Value = .UsedRange.Value
  
'削除
            .Range("A:B").Delete ' A 〜 B 列を削除
            .Range("1:9").Delete ' 1 〜 9 行目を削除
 
'グループ化 解除
            .Cells.ClearOutline
  
'列挿入
            .Columns("A").Insert ' A 列に挿入
            .Columns("A").ColumnWidth = 3
    
'列の非表示
            .Columns("B").Hidden = True 'を入力します。
  
 '高さ
            .Rows("1").RowHeight = 18
    
 'シート名
            .Name = "管理表"
    
 '新しいブックのパス設定
            .Protect Password:="1234"
            .Range("a1").Select
        End With
        Application.DisplayAlerts = False
        .SaveAs Filename:=DESKTOPPATH & "\" & file, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        .Close False
         
        MsgBox "デスクトップ_管理\管理表履歴へ出力しました。", _
                          vbOKOnly + vbInformation, MSGTITLE
    End With
End Sub
 

投稿日時: 19/07/06 14:21:16
投稿者: 里美

コメントが遅くなり、申し訳ありません。
皆様のおかげで、完成しました。
 本当ありがとうございました。
  感謝いたします。
   今後も、宜しくお願い致します。
     また、質問者へ暖かいコメント、アドバイスをお願い致します。