今日やっと鉄柵のカバーが取り外されて久し振りのベランダからの景色見れたわ～。
ホンマ、気も滅入ってたんで気分がその分良くなってきましたわ。人間閉鎖空間にいたらおかしくなってしまうって事ですわね( --) ・・・・・・
あと少しの辛抱だわね。
思ってたとおりの動きしてくれたしウハウハでしたわｗ
それとあのコードは処理を行うところを書き換えることで流用が出来そうね♪
これはとても便利なものを作ってしまったようだな・・・。
さて、風邪の方も薬のお陰で快方へ進んでいるもまだ完治ではないな＾＾； 暖かくして寝なければ・・・。
昨日イトーヨーカドーに敷き毛布買いにいったらマルチマットが15分限定の半額セールってのをやってましてね＾＾
3900円の敷きマットを半額の1950円で買うことが出来ましたわ＾＾
直のフローリングでなくなったのはホント助かるε=(￣。￣;) 敷き毛布も手前にちょっと写ってるけどすごく暖かくて気持ちよかったわ＾＾
話し変わるが風邪引いててとてもひどい頭痛がしてたんだわ(ノ_-;)…
頭痛だけひたすらするんでたまらんからしぶしぶ薬飲んだら治ったわ＾＾
・・・けど薬切れたらえらいことになりそうね(;´Д`A ```
持って行きますかね( --) ・・・・・・
結構悩み、苦しみましたが自分が望んでいるVBAが完成しましたZE
以下VBAソース
Sub SheetCopy3() 'ユーザーが指定したディレクトリ内にあるxlsデータ全てにシート分割処理を行う
Dim wb As Workbook
Dim strFnm As String
Dim strDir As String
Dim strDir2 As String
Dim i As Integer
Dim AWN As String
Dim ShtCnt As Integer
Dim ShellApp As Object
Dim SaveFolder As Object
Dim TargetFolder As Object
'処理をするディレクトリを決める
Set ShellApp = CreateObject("Shell.Application")
Set TargetFolder = ShellApp.BrowseForFolder(0, "処理を行うフォルダを選択してください。", 1)
If TargetFolder Is Nothing Then Exit Sub
'エラーチェック
If ThisWorkbook.Path = TargetFolder.items.Item.Path Then
MsgBox "このツールと同じフォルダにあるデータは処理できません。"
Exit Sub
End If
'保存するディレクトリを決める
Set SaveFolder = ShellApp.BrowseForFolder(0, "保存先フォルダを選択してください。", 1)
If SaveFolder Is Nothing Then Exit Sub
'処理を行うディレクトリ
strDir = TargetFolder.items.Item.Path
strDir2 = SaveFolder.items.Item.Path
'処理を行う対象データ
strFnm = Dir(strDir & "\*.xls")
'警告ウインドウ非表示
Application.ScreenUpdating = False
'処理開始
Do Until strFnm = ""
Set wb = Workbooks.Open(strDir & "\" & strFnm)
'処理内容
ShtCnt = wb.Worksheets.Count
'MsgBox ShtCnt
AWN = Left(wb.Name, Len(wb.Name) - 4)
'MsgBox AWN
i = 1
ChDir (strDir2)
Do
wb.Worksheets(i).Activate
wb.Worksheets(i).Copy
ActiveWorkbook.Close savechanges:=True _
, Filename:=AWN & "_" & ActiveSheet.Name & ".xls"
i = i + 1
'MsgBox "通過確認"
Loop Until i > ShtCnt
wb.Close False
strFnm = Dir() '次のファイル名
Loop
Application.ScreenUpdating = True
End Sub
__________________________
作ってて楽しかったわ＾＾
参考になったページは前の日記で紹介したもの＾＾
結構試行錯誤もしたし、エラーがでない不具合とかもでて苦しんだわ(￣Д￣;;
しまし不屈の闘士と発想の勝利とでも言うべきか。完成するとかなり嬉しいわｗ
後はこちらを色々と利用するまでですわ。偶然このページを見つけた方もコピペしてもらってかまわないけど自己責任で。
さて、これでもまだひとつ出来ただけにすぎないからね。
後思ってるマクロもあるけどそれは明日にしますかね～。
