[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『機能追加したい』（なーくん）
以前に、こちらで教えて頂いたマクロで一部追加したいのですが教えてください。 今の仕様は、ファイルをコピーする時に名前をつけて保存がでてきて、マイドキュメントが指定された状態です。 これをデスクトップに指定し直して、新しいフォルダを作り、ファイル名を入力して保存しています。 2回目以降のコピー作業は、新しいフォルダを指定している状態なのでそのまま保存しています。
今回追加したい事は、1回目のコピー作業をする時に、マイドキュメントではなく、デスクトップが指定された状態にしたい。 そして、ファイル名を入力作業をなくす為に、、FoundPathから表示したいです。 2回目以降のコピー作業は、今までと同じで新しいフォルダを指定している様にしたい。
１．イにすると、毎回デスクトップになる。 ２．InitialFileName:=FoundPathにしても変化なし
といった感じなので、どうかご教授願います。
なーくん
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Target
If (.Column = 6 Or .Column = 8) And .Count = 1 Then
If .Value = "PDF" Or .Value = "DXF" Then
検索 Target
End If
End If
End With
End Sub
Sub 検索(myRng As Range)
Dim FoundRng As Range
With Worksheets("ﾘｽﾄ").Columns("B")
Set FoundRng = .Find(myRng.EntireRow.Cells(2).Value, .Cells(.Cells.Count), _
xlValues, xlWhole, xlByRows, xlNext, False)
End With
If FoundRng Is Nothing Then ' Exit Sub
MsgBox "リストと一致しません"
Else
処理 myRng, FoundRng.Offset(, 1).Value
End If
End Sub
Sub 処理(myRng As Range, FolderPath As String)
Dim FindFileName As String
Dim FoundPath As String
Dim FileSaveName As String
Dim Ans As Long
FindFileName = myRng.EntireRow.Cells(2).Value & myRng.EntireRow.Cells(4).Value & "*." & myRng.Value
FoundPath = Dir(FolderPath & FindFileName)
If FoundPath = "" Then
MsgBox "該当ファイルがありません。", vbExclamation
Else
Ans = MsgBox("ファイルが見つかりました。" & vbLf & _
"ファイル名 ： " & FoundPath & vbLf & vbLf & _
"ファイルを開く" & vbTab & "： はい" & vbLf & _
"ファイルを保存" & vbTab & "： いいえ" & vbLf & _
"処理を中止する" & vbTab & "： キャンセル" & vbLf & vbLf & _
"を押してください。", vbYesNoCancel)
Select Case Ans
Case vbYes
If myRng.Value = "PDF" Then
ThisWorkbook.FollowHyperlink FolderPath & FoundPath
Else
MsgBox "このファイルは開く事は出来ません！「いいえ」の保存を実行して下さい！！"
End If
Case vbNo
'現在のﾏｸﾛ
FileSaveName = Application.GetSaveAsFilename(StrReverse(Split(StrReverse(FoundPath), "\", 2)(0)), _
fileFilter:=myRng.Value & "ファイル, *." & myRng.Value)
''毎回ﾃﾞｽｸﾄｯﾌﾟが表示されるが・・・イ
FileSaveName = Application.GetSaveAsFilename(InitialFileName:=CreateObject("WScript.Shell").SpecialFolders("Desktop"), _
' fileFilter:=myRng.Value & "ファイル, *." & myRng.Value)
If FileSaveName <> "False" Then
FileCopy FolderPath & FoundPath, FileSaveName
End If
Case vbCancel
'キャンセルの場合の処理
End Select
End If
End Sub
＜ 使用 Excel：Excel2003、使用 OS：Windows7 ＞
こんな感じで選択肢を増やせるのではないかと思います。そういう問題ではない？
開く、保存、処理中止 ↓ 開く、デスクトップに保存、マイドキュメントに保存、処理中止
（マナ） 2014/07/18(金) 21:12
http://www.asahi-net.or.jp/~ef2o-inue/kankyo/sub02_01.html
（マナ） 2014/07/18(金) 21:48
（マナ）さんコメントありがとうございます。
動きとしては、ばっちりです。 ですが、決まったファイルだけにしたいです。 それは可能ですか？
（なーくん） 2014/07/22(火) 11:30
ファイルを開く際に、カレントフォルダを変更し 必要なら、閉じる際に、マイドキュメントに戻すとか。
Private Sub Workbook_Open()
ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Sub
でも
＞動きとしては、ばっちりです。
ということならば、名前をつけて保存ダイアログの左側のショートカットバーの マイドキュメントやデスクトップをクリックで十分では？ １クリックするだけで、そんなに手間でもないような気がするのですが。
（マナ） 2014/07/22(火) 22:32
（マナ）さんコメントありがとうございます。
>１クリックするだけで、そんなに手間でもないような気がするのですが。 そうなんですが、毎回となると、この１クリックもなくす事できないかなぁと思うようになりまして・・・。
教えてもらった内容を取り込んでみます。
>２．InitialFileName:=FoundPathにしても変化なし について、何かいい方法ありますか？
（なーくん） 2014/07/23(水) 16:11
>２．InitialFileName:=FoundPathにしても変化なし
変化なしの意味が理解できません。カレントフォルダが開かれて、 保存ファイル名としてFoundPathを表示されるというコードですが そうはなりませんか。
期待している動作と、実際の動作を具体例で説明して下さい。
（マナ） 2014/07/25(金) 20:43
（マナ）さんコメントありがとうございます。
>>２．InitialFileName:=FoundPathにしても変化なし
>変化なしの意味が理解できません。カレントフォルダが開かれて、 >保存ファイル名としてFoundPathを表示されるというコードですが >そうはなりませんか。
FoundPathの内容を表示するはずなのに表示しないと言う意味です。 なので、いったん仮にA1に文字を入力し、参照するようにしてみると参照しました。（A1=abc) そこでA1の内容をFoundPathの内容になるように手入力しました。（A1=qaz-A△2.PDF） すると、参照しなくなりました。 A1=qaz-A△2にすると参照しました。
１．ここで質問です。
なぜですか？「.PDF もしくは.DXF」はどんな悪さをしているか、わかりますか？
とりあえず、以下の様にしてFoundPathから抜き出す事ができました。
このようなｽﾃｯﾌﾟを踏まないとFoundPathは利用できませんか？
Dim ファイル名 As String
Dim 全文字数 As Long
ファイル名 = FoundPath
全文字数 = Len(ファイル名)
ファイル名 = Left(ファイル名, 全文字数 - 4)
FileSaveName = Application.GetSaveAsFilename(ファイル名, _
FileFilter:=myRng.Value & "ファイル, *." & myRng.Value)
なので、
FileSaveName = Application.GetSaveAsFilename(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ファイル名, _
FileFilter:=myRng.Value & "ファイル, *." & myRng.Value)
にするとﾃﾞｽｸﾄｯﾌﾟを指定する所までできました。
２．また最初に戻るのですが、毎回ﾃﾞｽｸﾄｯﾌﾟになります。
新しくﾌｫﾙﾀﾞを作成した場合、以降はその新しいﾌｫﾙﾀﾞを参照して欲しいです。
どうすればできますか？
（なーくん） 2014/07/29(火) 10:25
Sub test()
Dim ファイル名 As String
Dim FileSaveName As String
ファイル名 = "qaz-A△2.pdf"
FileSaveName = Application.GetSaveAsFilename(ファイル名, _
FileFilter:="PDF" & "ファイル, *." & "pdf")
End Sub
（マナ） 2014/07/29(火) 20:57
＞ ２．また最初に戻るのですが、毎回ﾃﾞｽｸﾄｯﾌﾟになります。 ＞ 新しくﾌｫﾙﾀﾞを作成した場合、以降はその新しいﾌｫﾙﾀﾞを参照して欲しいです。 ＞ どうすればできますか？
InitialFileNameでパスを指定すればそのフォルダを開けますが
1回めかどうかは、どうしたら判断できるのですか？ 新しいフォルダの名前も決まっていないのですよね？
パスを指定しなければ、カレントフォルダが開きますので 初回のデスクトップだけ、左側のショートカットバーの１クリック手間が増えますが 2回め以降はは、最初から新しいフォルダで開くと思いますが。
（マナ） 2014/07/29(火) 21:24
（マナ）さんコメントありがとうございます。
>理由はわかりませんが、私の環境では、拡張子を小文字で揃えれば、表示されました。 私のほうでは、小文字に揃えても表示されません。
>Sub test() > Dim ファイル名 As String > Dim FileSaveName As String
> ファイル名 = "qaz-A△2.pdf"
> FileSaveName = Application.GetSaveAsFilename(ファイル名, _ > FileFilter:="PDF" & "ファイル, *." & "pdf")
>End Sub
これは大文字、小文字どちらも表示されます。
Sub Macro1()
Application.DefaultFilePath = "C:\Users\ﾕｰｻﾞｰ名\desktop"
End Sub
Sub Macro2()
Application.DefaultFilePath = "C:\Users\ﾕｰｻﾞｰ名\Documents"
End Sub
このマクロでカレントフォルダの切換が出来そうです。
Macro1は
Sub Macro3()
Application.DefaultFilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Sub
で行けそうですが、Documentsに戻すのはどうすればできますか？
（なーくん） 2014/07/31(木) 09:27
SpecialFolders は MyDocuments もサポートしています。 http://msdn.microsoft.com/ja-jp/library/cc364490.aspx （Mook） 2014/07/31(木) 10:11
（Mook）さんコメントありがとうございます。
Sub Macro4()
Application.DefaultFilePath = CreateObject("WScript.Shell").SpecialFolders("Documents")
End Sub
で、できなかったです。
DocumentsをMyDocumentsにしたらできました。 （なーくん） 2014/07/31(木) 12:02
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.