Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

57428 / 76732

←次へ　｜　前へ→


	【24041】Re:名前を付けて保存

yamazaki - 05/4/10(日) 19:49 -


	引用なし

	パスワード

▼kazu さん：
>こんな感じでどうでしょうか？
>
>
>On Error GoTo errmsg
>Dim Obj As Object
>Dim myDir As String
>Dim S As String
>
>　　AryNoUse = Array("\", "/", ":", ",", ";", "*", "Print", """", "<", ">", "|")
>
>　　Set Obj = CreateObject("Shell.Application"). _
>　　BrowseForFolder(0, "保存したいフォルダを選択して「OK」ボタンをクリックして下さい｡", 0)
>
>　　If Obj Is Nothing Then Exit Sub
>
>　　myDir = Obj.Self.Path
>　　
>　　If Obj.Title = "マイコンピュータ" Then
>　　　　MsgBox "マイコンピュータは選択しないで下さい。", vbExclamation
>　　　　Exit Sub
>　　End If
>　　
>　　UserForm1.Show
>
>
>errmsg:
>
>'-------------------------------------------------------------------------
>　　Fnm = UserForm1.TextBox1.Value
>　　If Fnm = "" Then
>　　 MsgBox "ﾌｧｲﾙ名が指定されていません。"
>　　 Exit Sub
>　　End If
>　　
>　　For Each Chk In AryNoUse
>　　　　If InStr(1, Fnm, Chk) <> 0 Then
>　　　　　　MsgBox "ﾌｧｲﾙ名に不適切な文字が含まれています。" & vbCrLf & "処理を中止します。", vbExclamation
>　　　　　　Exit Sub
>　　　　End If
>　　Next
>
>　　 Application.DisplayAlerts = False
>　　 S = myDir & "\" & Fnm & ".xls"
>　　　If Dir(S) <> "" Then
>　　　　 If MsgBox("既に存在します。上書きしますか", vbQuestion + vbYesNoCancel) = vbYes Then
>　　　　　　Kill S
>　　　　 Else
>　　　　　　MsgBox "Noが選択されたので処理を中止します。"
>　　　　　　Exit Sub
>　　　　 End If
>　　　Else
>　　　　 ActiveWorkbook.SaveAs myDir & "\" & UserForm1.TextBox1.Value & ".xls"
>　　　　 Application.DisplayAlerts = True
>　　　　 Application.Quit
>　　　End If

kazu さん　返信ありがとうございます。やはり無理でした。なぜ無理なのか考えてみたところもしかすると、バージョンの問題ではないか？という結論に達しました。
ちなみにWin98でExcel2000を使用。
しかし考え方のヒントにはなりました。ありがとうございます。

0 hits

▼

【23846】名前を付けて保存 yamazaki 05/4/5(火) 20:06