いちばん失敗した人決定戦

マクロコードについて教えてください。
下記はExcelファイルをセルDF1値のファイル名にて指定フォルダー内に保存するコードですが
Sub 紙保存()
Application.GetSaveAsFilename InitialFileName:="\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\" & Range("CF1 ").Value
End Sub
指定フォルダーを示して、
名前を付けて保存が立ち上がり、ファイル名も自動で表示されて
最後に「保存(S)をクリックしても
指定フォルダー内に保存されません。
何も保存されない状態です。
コードに問題があるのでしょうか?
以前、指定フォルダーを設定しないコードの時は
Sub 青紙保存()
Application.Dialogs(xlDialogSaveAs).Show Arg1:=Range("CF1 ").Value
End Sub
は自分で指定してフォルダー内に保存出来てました。
解決方法を教えてください。
よろしくお願いいたします。
尚、ファイルには1~22までのシートがあります、このファイル全体を保存したいです。
よろしくお願いいたします。

「エクセルのマクロについて教えてください。」の質問画像

質問者からの補足コメント

  • どう思う?

    回答ありがとうございます。
    貴殿のご指示通りに
    Application.Dialogs InitialFileName:="\\nas-sp01\~
    に設定をしましたが、
    エラーが出てしましました。
    申し訳ありませんが対処方法を教えてください。
    尚、私の都合で申し訳ありませんが、
    本日、これから地方に出かけますので確認は明日の朝以降になると思います。
    よろしくお願いいたします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2022/01/11 17:31
  • うーん・・・

    ご連絡が遅くなり、申し訳ありませんでした。
    上手く設定が出来ました。
    しかし同じ、コードをコピーして
    下記のように少し内容を変更した場合ダイアログボックスを表示の「ファイル名」に何も表示が無く
    空白になってしまいます。

    No.2の回答に寄せられた補足コメントです。 補足日時:2022/01/12 12:31
  • うーん・・・

    Sub 電子保存()
    Const folder As String = "\\Nas-sp01\share\~\"
    Dim newName As Variant
    Dim initName As String
    initName = folder & Range("CF1").Value
    newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm")
    If newName = False Then Exit Sub
    ThisWorkbook.SaveAs (newName)
    End Subのコードです。問題がありますでしょうか?

      補足日時:2022/01/12 12:38
  • うーん・・・

    回答ありがとうございます。
    指定フォルダー以外に
    initName = folder & Range("CE1").Value
    を変更しております。何度かか、マクロを削除し、作成し直したり
    ファイル名を変更して保存し直したり、しましたが、指定フォルダーのダイナログは間違いなく開くのですが、ファイル名にセルCE1値が表示されません
    新しいファイル「テスト」で「紙保存」「電子保存」のマクロを作成しまして実行しましたが
    やはり、紙保存では指定フォルダが開き、セルCF1値の名前が表示されますが、電子保存を実行した場合は、元データーと同じ状況で、ダイナログで指定フォルダには行きますが、やはり、ファイル名にセル値CE1が表示されません、何か問題があるのでしょうか?
    何度も申し訳ありません、よろしくお願いいたします。

    No.4の回答に寄せられた補足コメントです。 補足日時:2022/01/12 14:20
  • うーん・・・

    回答ありがとうございます。問題点が解ったように思います。紙保存のマクロを使用しセルCFとCE1とで試してみるとそれぞれ上手くフェイル名が表示されます。電子保存先の指定フォルダに問題があるのでしょうか?ワードにそれぞれの指定フォルダを保存して紙保存指定フォルダををクリックすると
    「share」からフォルダ名が始まりますが、電子保存の指定フォルダをクリックすると「ネットワーク share」となります。この違いではないかと思いますが、指定フォルダを選択する時はお内容にコピーをしているのですが、shareの前にネットワークがあるのが問題だと思いますが、
    どうすればよいでしょうか?こちら側のPCの設定の問題でしょうか?
    申し訳ありません、よろしくお願いいたします。

    「エクセルのマクロについて教えてください。」の補足画像5
    No.5の回答に寄せられた補足コメントです。 補足日時:2022/01/12 15:35
  • つらい・・・

    何度もありがとうございます。ご指示の通り、initName = folder & Worksheets("Sheet7").Range("CF1").Value又はinitName = folder & Worksheets("建築物(表面5.3").Range("CF1").Valueと実際のシート名にしましたがどちら新しいコード部分が黄色くエラーになってしまいます。
    両方のフォルダ先を調べた処、紙保存のフォルダ名が長い為、ネットワークが画面に表されないだけの様です。困りました。何が原因なのかがさっぱりわからなくなってしまいまして・・・よく使うマクロは電子保存なのでこれだけでも上手くいけばよいのですが。
    よろしくお願いいたします。

    No.6の回答に寄せられた補足コメントです。 補足日時:2022/01/12 16:00
  • うーん・・・

    多くの回答ありがとうございます。initName = folder & "ABCD"ですが全く何も表示されませんでした。又、①②ともエラーが出てしまい。黄色くなります。initName = folder & Worksheets("建築物(表面)5.3").Range("CE1").Value シートですが「建築物(表面)5.3」のシートにセルを合わしてマウスの右クリックをし、「コードの表示を表示すると「Sheet7(建築物(表面)5.3)」のところを示します。紙保存も同じシートなのですが・・やはり、こちら側の問題でしょうか?
    よろしくお願いいたします。

    No.9の回答に寄せられた補足コメントです。 補足日時:2022/01/12 16:51
  • うーん・・・

    お世話になっております。ダイナログ表示無のコードを設定するとCE1値でのファイル名で自動保存されました。
    試しに、Sub 電子保存()
    Const folder As String = "\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\"
    Dim newName As Variant
    newName = folder & Range("CF1").Value & ".xlsm"
    ThisWorkbook.SaveAs (newName)
    End Sub ダイナログが問題なのでしょうか?
    よろしくお願いいたします。本日、これからパソコンから離れてしまします。勝手申しますが、確認を明日の朝以降となります。もぅしわけ有りません。

    No.8の回答に寄せられた補足コメントです。 補足日時:2022/01/12 17:05
  • つらい・・・

    ありがとうございます。相当に詰まってまして・・色々回答していただけているのに上手くいかず、どうしてよいかが検討が付きません。紙保存では上手くいくのに電子保存で指定フォルダを変更すると上手くいかないんです。貴殿の助言を参考にさせて頂こうと思いますが、全てのコードを教えて頂けますでしょうか?申し訳ありません、よろしくお願いいたします。

    No.10の回答に寄せられた補足コメントです。 補足日時:2022/01/12 17:26
  • うーん・・・

    おはようございます。数日前より数多くの回答をありがとうございます。今回のシートのコピペでもやはり上手くいきませんでした、ダイヤログを表示させる目的はコード設定した指定フォルダ「\\Nas-sp01\~\1.受付\」最後の受付フォルダの中に物件ごとのフォルダがあり、保存する場合にその物件ごとのフォルダ内に保存をする事が目的です。(この物件フォルダは日々変更されますので)現状の方法として、貴殿から教えて頂きました、ダイヤログを表示させない方法では\1.受付\内にCE1値のファイル名で保存されますので、その後、そのファイルを物件ごとに移動する方法があります。当面はこの方法でやっていきたいと思いますが、今回の内容で別案がありましたらお願いできますでしょうか?何度も申し訳ありません、補足回数も後1回になってしまいました。よろしくお願いいたします。

    No.14の回答に寄せられた補足コメントです。 補足日時:2022/01/13 10:00

A 回答 (15件中11~15件)

Range("CE1").ValueはアクティブシートのCE1セルの意味です。


アクティブシートとは、今、表示されているシートのことです。

まず、CE1セルを画面に表示してしてください。
そのあとで、マクロを実行してください。
この回答への補足あり
    • good
    • 0

変更されたのは以下の行のみですね。

(プロシージャ名を除く)
Const folder As String = "\\Nas-sp01\share\~\"
そうであれば、上記のフォルダ名が実在しない可能性が考えられます。
フォルダ名が正しいかどうか(文字の打ち間違いがないかどうか)、再確認してください。
この回答への補足あり
    • good
    • 0

こんにちは


既に解決出来るであろう回答があり、投稿を迷いましたが、別方法も書いていたので参考程度として投稿します。

https://oshiete.goo.ne.jp/qa/12748252.html で回答したものです
イマイチ使用用途が解らなかったので
決め打ちアドレス、ファイル名なら直接、ダイアログ表示なしで保存しても
良いかなと思いました。(#2様回答済)
調べていませんが、Dialogsで行う場合はカレントフォルダ変更などを実施してターゲットフォルダを指定しますが、ネットワークには変更できなかった記憶があります。(まで前回の詳細)

ファイルパスやファイル名を変更する可能性があるのでしたら、
たどり着いた GetSaveAsFilenameでパス、ファイル名を取得、取得パスでThisWorkbook.SaveAsで良いです。

#1様が回答されていますが、
GetSaveAsFilename はファイルパス取得のダイアログ表示メソッドです
この情報があるサイトには、多くの場合 GetSaveAsFilenameメソッドと
ThisWorkbook.SaveAs メソッドが対で書いてあると思います。

GetSaveAsFilenameでの例を挙げますが、名前を付けて保存実行したブック(開かれているブック)は、保存したブックに置き換わります。
元ブックでなくなりますので 名前を付けて保存を実行する前に上書き保存する必要があると思います。
(元ファイル(入力用ブック?)の詳細が解らないのでここはグレーです)

マクロは保存しない場合
ActiveWorkbook.Save '元ファイル変更を維持する場合、必要
saveFilePath = Application.GetSaveAsFilename ("\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\" & Range("CF1 ").Value, "Excel File (*.xlsx),*.xlsx")
If Not (saveFilePath = "False") Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs saveFilePath, 51 '51 マクロ無し.xls .xlsx
Application.DisplayAlerts = True
End If

マクロ付の場合は.xlsxを.xlsmへ 51を52で

実行ブックがテンプレ(ActiveWorkbook.Saveしない)のようなもので、このまま閉じるのなら良いのですが、、続けて何度もブックを作成したい場合は、必要シートで新規ブックを作成して保存するロジックの方が良いかも知れません。

>ファイルには1~22までのシートがあります、このファイル全体を保存したいです。

新規ブックを作成すべてのシートを保存する場合は

Sub Create_NewFile() '実行プロシージャ
Dim myBk As Workbook
Dim fso As Object
Dim saveFilePath As String
Dim Exte As Integer
Dim j As Long: j = 0
Dim Array_sheets() As String
Dim s As Variant
Set myBk = ActiveWorkbook
saveFilePath = Application.GetSaveAsFilename _
("\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\" & Range("CF1 ").Value, "Excel File (*.xls*),*.xls*")
If saveFilePath = "False" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.GetExtensionName(saveFilePath) = "xlsm" Then Exte = 52
If fso.GetExtensionName(saveFilePath) = "xlsx" Then Exte = 51

myBk.Sheets.Select
For Each s In ActiveWindow.SelectedSheets
If s.Index <> 1 Then
ReDim Preserve Array_sheets(j)
Array_sheets(j) = s.Name
j = j + 1
End If
Next s
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'<新規にブックを追加します。>
myBk.Sheets(1).Copy
With ActiveWorkbook
If j <> 0 Then
myBk.Sheets(Array_sheets).Copy , .Sheets(.Sheets.Count)
.Sheets(1).Activate
End If
If Dir(saveFilePath) <> "" Then
MsgBox ("同名ファイルが存在します" & vbCrLf & "一時的にデスクトップに保存します")
.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("desktop") _
& "\同名_" & fso.GetBaseName(saveFilePath), FileFormat:=Exte
.Close
Else
.SaveAs Filename:=saveFilePath, FileFormat:=Exte
.Close
End If
End With
ThisWorkbook.Activate
Sheets(1).Select Replace:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

こんな感じです
    • good
    • 0

失礼しました。


質問の意図は「ダイアログボックスを表示し、保存を選択すると、その名称で保存したい」と理解していました。
Application.Dialogs で可能ですが、ファイル名にフルパスを指定することはできません。
その為、Application.Dialogsで行う場合は、ファイル名だけを指定することになります。そうすると、ダイアログボックスが表示された後、
"\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\"のフォルダまで、フォルダを移動して、その後保存することになります。

そのような面倒なことはせずに、一発で、"\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\"下に保存したいということであれば、
そもそも、ダイアログボックスを表示する必要はありません。いきなり、そこへ保存すれば良いわけです。その場合、以下のようになります。

Sub 紙保存()
Const folder As String = "\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\"
Dim newName As Variant
newName = folder & Range("CF1").Value & ".xlsm"
ThisWorkbook.SaveAs (newName)
End Sub

但し、ダイアログボックスを表示するのが目的なら、以下のようにしてください。
Sub 紙保存()
Const folder As String = "\\nas-sp01\share\○○部\○○\○○\○○班用\★★★○○申請\"
Dim newName As Variant
Dim initName As String
initName = folder & Range("CF1").Value
newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm")
If newName = False Then Exit Sub
ThisWorkbook.SaveAs (newName)
End Sub
この回答への補足あり
    • good
    • 0

ヘルプをみると


Application.GetSaveAsFilename メソッド
ユーザーからファイル名を取得するために、[名前を付けて保存] ダイアログ ボックスを表示します。ダイアログ ボックスで指定したファイルは、実際には保存されません。

と書いてあるように、保存をクリックしても、実際に保存はされないです。
Application.Dialogsを使用したほうが良いと思います。
この回答への補足あり
    • good
    • 0

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