エクセルVBA 保存ダイアログの保存を選択

VBAで表示された保存ダイアログの保存を押したいです。
Set xlAPP = Application

' '｢名前を付けて保存｣のﾌｫｰﾑでﾌｧｲﾙ名の指定を受ける
' xlAPP.StatusBar = "出力するファイル名を指定して下さい。"


seiNo = Sheets(cnsSH4).Cells(2, 9).Value
seiCo = Sheets(cnsSH4).Cells(2, 12).Value
seiriNO = seiNo & seiCo

strFILENAME = xlAPP.GetSaveAsFilename( _
InitialFileName:=seiriNO & ".txt", _
FileFilter:=cnsFILTER, Title:=cnsTITLE)
今使用しているVBAが、保存ダイアログを表示してファイル名をエクセルから抽出するタイプになっています。でもダイアログ表示なくそのまま保存して欲しくて…。
変更方法がわからないので、ダイアログを表示した状態で、さらに保存ボタンを押す記述を増やす方法でいこうと思っています。
ご教示願います。

No.1 回答者： GooUserラック 回答日時： 2016/11/11 15:18

内容が良く判りません。

どんなファイルを保存するのでしょうか？
Ｅｘｃｅｌのファイル（拡張子が「.xlsx」など）なら「保存ダイアログ」など出さず名前をつけて保存は簡単に出来ます。

この回答へのお礼

有難うございます。Excelファイルを、.txtで、ファイル内の指定セルにある番号をファイル名にして、指定のフォルダに保存しようと思っています。

お礼日時：2016/11/11 15:46

No.2 回答者： naktak 回答日時： 2016/11/11 15:27

ダイアログを呼び出しているところを、絶対パスを得るようにコードを変えればいいだけでは。

ダイアログ表示をしたくないということは、どのパスに保存するか、が決まっているということですよね。
であるならば、ダイアログ表示処理がそもそも不要だということになるでしょう。

この回答へのお礼

有難うございます。
strFILENAME = xlAPP.GetSaveAsFilename( _
InitialFileName:=seiriNO & ".txt", _
FileFilter:=cnsFILTER, Title:=cnsTITLE)
のあたりを、ファイルや名前を指定して保存！だけのコードに変更ということでしょうか…
さっぱり初心者で申し訳ないです；；

お礼日時：2016/11/11 15:48

No.3 回答者： GooUserラック 回答日時： 2016/11/11 16:03

「.txt」で保存するファイルは、このＶＢＡのコードがあるブックの１シートでしょうか？それとも別なファイルでしょうか？

この回答へのお礼

VBAコードは個人マクロブックに保存していて、そのコードを使うのは毎度違うブックです。

お礼日時：2016/11/11 16:13

No.4 回答者： GooUserラック 回答日時： 2016/11/11 17:33

こんな感じでいかがですか？

-------------------------------------------------------------
Sub 名前を付けて保存()
Dim ファイル名 As String
ファイル名 = ThisWorkbook.Path & "\"
ファイル名 = ファイル名 & Cells(2, 9).Value & Cells(2, 12).Value
ファイル名 = ファイル名 & ".txt"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=ファイル名, FileFormat:=xlText, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub
-------------------------------------------------------------
なお「.txt」で保存するファイルはアクティブ状態にしておいてください。
・保存後「.txt」で保存するファイルを閉じますが、開いたままが良ければ「ActiveWindow.Close」を削除して下さい。
・個人マクロブックと同じフォルダーに保存しますが、別のフォルダーがよければ「ThisWorkbook.Path & "\"」を指定パスに入れ替えてください。

No.5 回答者： WindFaller 回答日時： 2016/11/12 02:08

質問で出てきたコードを、どこまで踏襲してよいのか分かりませんが、やっと出来上がりました。

思った以上にややこしい部分があります。
以下のコードで出てくる「ファイル名チェッカー」というWin32 APIにあったはずですが、どうしても思い出せませんので、かようなしだいになりました。

ある程度のトラブルを予想して作りをしました。と言っても、私の書いたものは複雑でわかりにくい、だからボツという人もいます。ただ、私が何を考えて作ったかは、もし多少でも興味がおありでしたら、ざっとで読んでみるとよいでしょう。

>VBAコードは個人マクロブックに保存していて、そのコードを使うのは毎度違うブックです。

個人用マクロブックに入れる場合は、丁寧にマクロをのコードを整頓して入れます。安易に作ると、Excel全体の起動などに影響を及ぼします。

>ダイアログ表示なくそのまま保存して欲しくて
それは分かるけれども、綿密なロジックでエラーなど絶対ださないような作りにしないといけません。エラートラップでもよいのですが、今回は、それはしていません。

具体的に
>seiNo = Sheets(cnsSH4).Cells(2, 9).Value
>seiCo = Sheets(cnsSH4).Cells(2, 12).Value
>seiriNO = seiNo & seiCo

最初に、ネックになるのはここです。
今回の場合は、他のシートということは、ほとんど考えられません。ActiveSheet に限られるように思いました。

もう一つ、任意のシートを特定化させる条件が本来必要ですが、こちらからはそれが分かりません。

したがって、Sheets(cnsSH4)　→ActiveSheet 以外には考えられません。Text ファイルだとすれば、その画面だけになると思います。

私のマクロには、二つの特徴があります。
ひとつは、S-JISとUnicode の両方で保存できます。
同名ファイルの時は、枝番が付くことになります。

このマクロには、ThisWorkbook やThisWorkbook.Path などはありえません。あくまでも、DefaultFilePath か、ActiveWorkbook.Path のどちらかになります。

ダイアログを使わないということは、ファイル名の正当性が分かりませんから、別途ファイル名チェッカーを付け加えることにしました。

また、Unicodeの場合と、SJISは、若干仕様が違います。
なかなか、慣れないと出来ない種類のものだと思います。

もし、個人用マクロブックをパスワードでロックする場合は、On Error のエラートラップを設けておいてください。

'//個人用マクロブック・標準モジュール
Sub SaveFileMacro()
　Dim sNo As Variant
　Dim sCo As Variant
　Dim serialNo As String
　Dim mPath As String
　Dim fName As String
　Dim j As Long
　Const EXT As String = ".txt"　'拡張子
　'文字コード
　Const UNI As Long = xlUnicodeText
　Const JIS As Long = xlText
　Dim charCode As Long
　charCode = UNI
　With ActiveSheet
　　sNo = .Cells(2, 9).Text
　　sCo = .Cells(2, 12).Text
　　If sNo = "" Or sCo = "" Then
　　　MsgBox "I2= '" & sNo & "' ,L2='" & sCo & "'" & vbCrLf & _
　　　"!ファイル名を決定する情報がありません｡ ", vbCritical
　　　Exit Sub
　　Else
　　　serialNo = sNo & sCo
　　End If
　　
　　mPath = ActiveWorkbook.Path
　　If mPath = "" Then mPath = Application.DefaultFilePath
　　If Right(mPath, 1) <> "\" Then mPath = mPath & "\"
　　
　　fName = mPath & serialNo
　　If FileNameChecker(fName) Then
　　　 MsgBox "ファイル名に禁じられた文字が入っています。", vbExclamation
　　　 Exit Sub
　　End If
　　Do While Dir(fName & EXT) <> ""
　　　If InStrRev(fName, "_") > 0 Then
　　　　fName = Mid$(fName, 1, InStrRev(fName, "_") - 1)
　　　End If
　　　j = j + 1
　　　fName = fName & "_" & CStr(j)
　　Loop
　　ActiveSheet.Copy
　　With ActiveWorkbook
　　　If charCode = UNI Then
　　　.SaveAs fileName:=fName & EXT, FileFormat:=charCode
　　　Else
　　　.SaveAs fileName:=fName, FileFormat:=charCode
　　　End If
　　　.Close False
　　End With
　End With
　MsgBox Dir(fName & EXT) & "は" & vbCrLf & _
　mPath & "に保存されました。", vbInformation
End Sub

Public Function FileNameChecker(ByVal fileName As String) As Boolean
'ファイル名で禁じらた文字が入っていないか調べる（汎用性あり)
Dim UnAvlblStr As Variant
Dim n As Variant
UnAvlblStr = Array("\", "/", """", "<", ">", "?", "[", "]", "|", "*")
fileName = Mid(fileName, InStrRev(fileName, "\") + 1)
For Each n In UnAvlblStr
If InStr(1, fileName, n, vbBinaryCompare) > 0 Then
　 FileNameChecker = True
　 Exit Function
End If
Next n
End Function

No.6 回答者： ママチャリ 回答日時： 2016/11/12 11:40

ご要望の通りに「保存」を押したいのであれば、strFILENAME = xlAPP.Get･･･の命令の直前に、SendKeys "{ENTER}" を入れれば、動くことは動きます（たぶん）。

こんな感じです。

SendKeys "{ENTER}"
strFILENAME = xlAPP.GetSaveAsFilename( _