Excel (VBA)

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

 
(指定なし : 指定なし)
Excel内にある複数シートを分割して別々のファイルに保存したい
投稿日時: 21/07/21 16:16:06
投稿者: DIVAA

Excelファイルに複数シートがあり、それを分割してシートごとに保存したいと思っています。
調べると下記コードを見つけました。

Sub saveSheet()
    Dim shObj As Worksheet
    Dim newBook As Workbook
    Dim newBookName As String
    Dim folderParent As String
    
    'シートの保存先はこのブックと同じとする
    '必要に応じてこの変数を
    folderParent = ThisWorkbook.Path & "\"
    
    'ワークシートの分だけ繰り返す
    For Each shObj In Worksheets
        'シート名を変数に格納しておく
        newBookName = shObj.Name & ".xlsx"
        
        'シートを新しいブックにコピーする
        shObj.Copy
        '移動先のブックがアクティブになっているので変数に格納する
        Set newBook = ActiveWorkbook
        '新しいブックを名前を指定して保存する
        newBook.SaveAs folderParent & newBookName
        '新しいブックを閉じる
        newBook.Close
    Next shObj
End Sub

 
このコードで実装したいことは完璧なのですがひとつだけ変更したい箇所があります。
 'シートの保存先はこのブックと同じとする
    '必要に応じてこの変数を
    folderParent = ThisWorkbook.Path & "\"

この部分を各自のデスクトップに保存したいのです。
自分のデスクトップだけだとデスクトップのファイルパスを入力すればいいと思うのですが、操作する人各自のデスクトップに保存したい場合どのようにコードを書けばいいのでしょうか?
 
教えて頂きたいです。

回答
投稿日時: 21/07/21 17:41:39
投稿者: WinArrow
投稿者のウェブサイトに移動

動作PCのデスクトップを取得するコード
 
Dim Path As String
 
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

投稿日時: 21/07/22 10:09:30
投稿者: DIVAA

WinArrow様
回答ありがとうございます。
記載いただいたコードを追加したところなぜかデスクトップではなく
ドキュメントに保存されてしまいます。。
なにか原因があるのでしょうか・・・?

回答
投稿日時: 21/07/22 12:23:25
投稿者: simple

どのように組み込んだのか教えてもらえますか?

投稿日時: 21/07/22 13:05:22
投稿者: DIVAA

simple様
コードの追加した部分でしょうか?
 
WinArrow様に提示して頂いたコードを組み込んだのは下記になります

Sub saveSheet()
    Dim shObj As Worksheet
    Dim newBook As Workbook
    Dim newBookName As String
    Dim folderParent As String
    Dim Path As String
  
    'シートをデスクトップに保存
    Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    
    'ワークシートの分だけ繰り返す
    For Each shObj In Worksheets
        'シート名を変数に格納しておく
        newBookName = shObj.Name & ".xlsx"
        
        'シートを新しいブックにコピーする
        shObj.Copy
        '移動先のブックがアクティブになっているので変数に格納する
        Set newBook = ActiveWorkbook
        '新しいブックを名前を指定して保存する
        newBook.SaveAs folderParent & newBookName
        '新しいブックを閉じる
        newBook.Close
    Next shObj
End Sub

回答
投稿日時: 21/07/22 14:23:42
投稿者: WinArrow
投稿者のウェブサイトに移動

人に与えられたコードをそのまま、組み込んでも
あなたの意図通りに動くとは、限りません。
 
あなたは、
> folderParent = ThisWorkbook.Path & "\"
の代わりのコードが欲しかったはずです。
 
 
私は、
>動作PCのデスクトップを取得するコード
を紹介しただけです。
 
あなたは、
>'シートをデスクトップに保存
と理解したようです。
 
コードをよく理解しましょうね・・・
 

回答
投稿日時: 21/07/22 14:40:18
投稿者: WinArrow
投稿者のウェブサイトに移動

DIVAA さんの引用:

記載いただいたコードを追加したところなぜかデスクトップではなく
ドキュメントに保存されてしまいます。。
なにか原因があるのでしょうか・・・?

 
の原因を説明しましょう。
VBAで、「名前を付けて保存」=.SaveAs
時に、ファイル名だけ指定すると「ドキュメント」フォルダに保存する設定になっているからです。
 
Excelのオプション設定ー「保存」の中の、
規定のローカルファイルの保存場所を
確認してk見てください。

投稿日時: 21/07/22 15:37:04
投稿者: DIVAA

正常に動くようになりました。
ありがとうございます。