Excel VBA質問箱 IV

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

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


12020 / 13645 ツリー ←次へ | 前へ→

【12685】指定したフォルダに保存するには... TOKU 04/4/12(月) 15:27 質問
【12697】Re:指定したフォルダに保存するには... ichinose 04/4/12(月) 18:10 回答
【12829】Re:指定したフォルダに保存するには... ichinose 04/4/16(金) 13:56 お礼

【12685】指定したフォルダに保存するには...
質問  TOKU  - 04/4/12(月) 15:27 -

引用なし
パスワード
   VBAでユ−ザーフォームから保存する時に、指定したフォルダに保存させるプログラムを教えて下さい。

例)『OK』ボタンを押したときに、デスクトップ上の『ABC』というフォルダに保存。

【12697】Re:指定したフォルダに保存するには...
回答  ichinose  - 04/4/12(月) 18:10 -

引用なし
パスワード
   ▼TOKU さん:
こんばんは。

>VBAでユ−ザーフォームから保存する時に、指定したフォルダに保存させるプログラムを教えて下さい。
>
>例)『OK』ボタンを押したときに、デスクトップ上の『ABC』というフォルダに保存。

'============================================
Sub test()
  Dim desktop_path As String
  desktop_path = get_sp_fullpath("Desktop") & "\ABC\"
  '         ↑デスクトップのフルパスを取得
  ans = bk_save(Workbooks("book1.xls"), desktop_path & "test1.xls")
'         ↑   指定のブックを指定のパス名で保存
  If ans = 0 Then
    mes = "保存成功"
  Else
    mes = Error$(ans)
    End If
  MsgBox mes
End Sub
'==============================================================
Function bk_save(bk As Workbook, svflnm As String) As Long
  On Error Resume Next
  bk_save = 0
  Application.DisplayAlerts = False
  bk.SaveAs Filename:=svflnm
  If Err.Number <> 0 Then
   bk_save = Err.Number
   End If
  Application.DisplayAlerts = True
  On Error GoTo 0
End Function
'================================================
Function get_sp_fullpath(keyword) As String
  Set WsShell = CreateObject("WScript.Shell")
  get_sp_fullpath = WsShell.SpecialFolders(keyword)
  '                     変数指定はVariantでね
  '                    そうしないと正しい解答を得られません
  Set WsShell = Nothing
End Function

確認してみて下さい。

【12829】Re:指定したフォルダに保存するには...
お礼  ichinose  - 04/4/16(金) 13:56 -

引用なし
パスワード
   ichinoseさん、ありがとうございました。
ichinoseさんのプログラムを参考にしたら出来ました。
また、機会がありました時には、宜しく御願いします。m(_ _)m


▼ichinose さん:
>▼TOKU さん:
>こんばんは。
>
>>VBAでユ−ザーフォームから保存する時に、指定したフォルダに保存させるプログラムを教えて下さい。
>>
>>例)『OK』ボタンを押したときに、デスクトップ上の『ABC』というフォルダに保存。
>
>'============================================
>Sub test()
>  Dim desktop_path As String
>  desktop_path = get_sp_fullpath("Desktop") & "\ABC\"
>  '         ↑デスクトップのフルパスを取得
>  ans = bk_save(Workbooks("book1.xls"), desktop_path & "test1.xls")
>'         ↑   指定のブックを指定のパス名で保存
>  If ans = 0 Then
>    mes = "保存成功"
>  Else
>    mes = Error$(ans)
>    End If
>  MsgBox mes
>End Sub
>'==============================================================
>Function bk_save(bk As Workbook, svflnm As String) As Long
>  On Error Resume Next
>  bk_save = 0
>  Application.DisplayAlerts = False
>  bk.SaveAs Filename:=svflnm
>  If Err.Number <> 0 Then
>   bk_save = Err.Number
>   End If
>  Application.DisplayAlerts = True
>  On Error GoTo 0
>End Function
>'================================================
>Function get_sp_fullpath(keyword) As String
>  Set WsShell = CreateObject("WScript.Shell")
>  get_sp_fullpath = WsShell.SpecialFolders(keyword)
>  '                     変数指定はVariantでね
>  '                    そうしないと正しい解答を得られません
>  Set WsShell = Nothing
>End Function
>
>確認してみて下さい。

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