リサーチ１１５

質問
VBScriptについて質問です。VBS初心者です。下記VBSについて質問です。'変数定義Dim wShell ' shellオブジェクトDim oExec ' execオブジェクトDim objFSO ' ファイルシステムオブジェクト Dim pathFrom ' 移動元パスDim pathFrom2 ' 移動元パスdim fsoDim objWshShelldim objSubFolderdim objSubFolders'①WScript.Shellオブジェクトの作成Set objWshShell = CreateObject("WScript.Shell")'カレントディレクトリを表示pathFrom = objWshShell.CurrentDirectorySet fso=CreateObject("Scripting.FileSystemObject")set sourceFolder = fso.GetFolder(pathFrom)set objSubFolders = sourceFolder.SubFoldersfor each objSubFolder In objSubFoldersSet wShell = CreateObject("WScript.Shell")pathFrom2 = pathFrom & "\" & objSubFolder.nameSet oExec = wShell.Exec("C:\Program Files\Lhaz\Lhaz.exe " & pathFrom2)pathFrom2 = pathFrom2 & ".lzh"'' 圧縮ファイルが生成されるまでループするWhile Not fso.FileExists(pathFrom2)Wendnext上記はｖｂｓと同一フォルダにある全てのフォルダを圧縮するようになっています。階層が浅いときにはうまくいくのですが、階層が深くなると、目的のフォルダより上位のフォルダを圧縮してしまい、うまくいきません。wShell.Execに渡せるパラメータの長さが制限を越えているのでしょうか？申し訳ありませんが、ご教授のほどよろしくお願いいたします。

ベストアンサー
深さではなく、空白を含むフォルダなどがあると空白以降がLhaz.exeの第2引数とみなされるので、pathFrom2を""で囲んであげます。>Set oExec = wShell.Exec("C:\Program Files\Lhaz\Lhaz.exe " & pathFrom2)をSet oExec = wShell.Exec("C:\Program Files\Lhaz\Lhaz.exe " & """" & pathFrom2 & """")またはSet oExec = wShell.Exec("C:\Program Files\Lhaz\Lhaz.exe """ & pathFrom2 & """")に。

質問
VBA初心者です。いつもお世話になってます。ネットで1ページに8枚写真を貼って次シートに8枚貼付けの繰り返しのコードを見つけたのですが左側にはコメントを書きたいので右側だけに写真を4枚貼って次シートにまた写真4枚貼付けの繰り返しを行いたいのですがうまく行きません。ご教授よろしくお願いします。Sub 画像貼り付け() '===============フォルダ選択 Set myPath = CreateObject("Shell.Application") _ .BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, 0) If myPath Is Nothing Then Exit Sub If myPath.Items Is Nothing Then Exit Sub If myPath.Items.Item Is Nothing Then Exit Sub フォルダ = myPath.Items.Item.Path Set myPath = Nothing 元シト = ActiveSheet.Name セル = Array("C2", "AO2", "C17", "AO17", "C32", "AO32", "C47", "AO47") i = 8 Set myFS = CreateObject("Scripting.FileSystemObject") For Each myF In myFS.GetFolder(フォルダ).Files myEXT = LCase(myFS.GetExtensionName(myF)) If myEXT = "jpeg" _ Or myEXT = "jpg" _ Or myEXT = "gif" _ Or myEXT = "tiff" _ Or myEXT = "bmp" _ Or myEXT = "png" _ Or myEXT = "tif" Then If i > 7 Then i = 0 Sheets(元シト).Copy after:=Sheets(Sheets.Count) End If '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) myMA = Range(セル(i)).MergeArea.Address '===============タテヨコの縮尺を保持 myHH = Range(myMA).Height / mySP.Height myWW = Range(myMA).Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Range(myMA).Width Else mySP.Height = Range(myMA).Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Range(myMA).Height / 2) - (mySP.Height / 2) myWW2 = (Range(myMA).Width / 2) - (mySP.Width / 2) mySP.Top = Range(myMA).Top + myHH2 mySP.Left = Range(myMA).Left + myWW2 Set mySP = Nothing i = i + 1 End If Next Set myFS = NothingEnd Sub

ベストアンサー
変更した行に[変更]というコメントを入れておきました。■変更後のコードSub 画像貼り付け()'===============フォルダ選択Set myPath = CreateObject("Shell.Application") _.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, 0)If myPath Is Nothing Then Exit SubIf myPath.Items Is Nothing Then Exit SubIf myPath.Items.Item Is Nothing Then Exit Subフォルダ = myPath.Items.Item.PathSet myPath = Nothing元シト = ActiveSheet.Nameセル = Array("AO2", "AO17", "AO32", "AO47") '[変更]i = 4 '[8⇒4へ変更]Set myFS = CreateObject("Scripting.FileSystemObject")For Each myF In myFS.GetFolder(フォルダ).FilesmyEXT = LCase(myFS.GetExtensionName(myF))If myEXT = "jpeg" _Or myEXT = "jpg" _Or myEXT = "gif" _Or myEXT = "tiff" _Or myEXT = "bmp" _Or myEXT = "png" _Or myEXT = "tif" ThenIf i > 3 Then '[ i>7 ⇒ i>3 へ変更]i = 0Sheets(元シト).Copy after:=Sheets(Sheets.Count)End If'===============画像の貼り付けSet mySP = ActiveSheet.Pictures.Insert(myF)myMA = Range(セル(i)).MergeArea.Address'===============タテヨコの縮尺を保持myHH = Range(myMA).Height / mySP.HeightmyWW = Range(myMA).Width / mySP.WidthIf myHH > myWW ThenmySP.Height = mySP.Height * myWWmySP.Width = Range(myMA).WidthElsemySP.Height = Range(myMA).HeightmySP.Width = mySP.Width * myHHEnd If'===============中央へ調整myHH2 = (Range(myMA).Height / 2) - (mySP.Height / 2)myWW2 = (Range(myMA).Width / 2) - (mySP.Width / 2)mySP.Top = Range(myMA).Top + myHH2mySP.Left = Range(myMA).Left + myWW2Set mySP = Nothingi = i + 1End IfNextSet myFS = NothingEnd Sub

質問
【EXCEL、マクロ、VBA】テキストファイルを指定の場所に新たに作成し、書き込みをしたいです。いつもお世話になっております。先日質問をさせていただいたばかりですが、また分からないことがでてきましたので質問させてください。詳しくは以下になります。①エクセルのsheet１のセルA1にある値でC直下にフォルダ作成。（今回は仮にAAAとします）②AAAの配下にABCというフォルダを作成。③ABCの配下にaaa、bbb、cccという3つのフォルダを作成。④aaaの配下にabc.txtというテキストファイルを作成。現在できているマクロは以下になります。Sub A1の値でフォルダ作成() 'Cドライブ直下にセルA1に記載された番号でフォルダを作成する Dim A1folder As String Dim v As Variant A1folder = "c:\" & Worksheets("Sheet1").Range("A1").Value MkDir A1folder MkDir A1folder & "\ABC" For Each v In Array("aaa", "bbb", "ccc") MkDir A1folder & "\ABC\" & v Next End Sub Sub test()' aaa配下にテキストファイル"abc.txt" を作ってABCDEを書き込むDim objFS, objFolder, objTSSet objFS = CreateObject("Scripting.FileSystemObject")Set objFolder = objFS.GetFolder("C:\AAA\ABC\aaa")Set objTS = objFolder.CreateTextFile("abc.txt")objTS.WriteLine "ABCDE"objTS.CloseEnd Sub治したいところは、abc.txtを作成する場所のパスです。現在は、"C:\AAA\ABC\aaa" としていますが、C直下のAAAはsheet1のA1セルから引っ張ってきたものです。毎回A1セルの値は変わるので"C:\AAA\ABC\aaa"を正しく直したいです。このような場合は、パスをどのように記述するべきでしょうか？

ベストアンサー
Set objFolder = objFS.GetFolder("C:\AAA\ABC\aaa")これをSet objFolder = objFS.GetFolder("c:\" & Worksheets("Sheet1").Range("A1").Value & "\ABC\aaa")こんな感じじゃないですか？

質問
CSVファイルの全てのフィールドを文字列形式で作成したい。Sub DataGet() Dim myFileName9 As String Dim myDataobj As DataObject Dim myFSO As Scripting.FileSystemObject Dim myTst As Scripting.TextStream Dim myStr As String Dim myDataRng As Range '保存ファイル名 myFileName9 = "コード対比表.csv" On Error Resume Next '同名ファイルの削除 Kill ThisWorkbook.path & "\システムフォルダ\取込用CSVファイル\" & myFileName9 On Error GoTo 0 '保存するシートを指定する Set myDataRng = Worksheets("対比表").Cells(1, 1).CurrentRegion 'データをクリップボードへ myDataRng.Copy 'クリップボードから文字列変数へ Set myDataobj = New DataObject myDataobj.GetFromClipboard myStr = myStr & Replace(myDataobj.GetText, vbTab, ",") 'オブジェクトの解放 Set myDataobj = Nothing '文字列変数から、ファイルへ Set myFSO = New Scripting.FileSystemObject Set myTst = myFSO.OpenTextFile( _ fileName:=ThisWorkbook.path & "\システムフォルダ\取込用CSVファイル\" & myFileName9, _ IOMode:=ForWriting, Create:=True) myTst.Write myStr myTst.Close Application.CutCopyMode = False 'オブジェクトの解放 Set myTst = Nothing Set myFSO = NothingEnd Subこのコードを使ってCSVファイルを造っているのですが、全て文字列にするにはどのように改変すればよろしいでしょうか？宜しくお願いいたします...

ベストアンサー
「全て文字列にする」というのが、どの程度の事かわかりかねますが、各フィールドをダブルクォートで囲むだけならば、myStr = myStr Replace(myDataobj.GetText, vbTab, ",")↓↓↓↓↓↓↓myStr = myStr & """" & Replace(myDataobj.GetText, vbTab, """,""") & """"でいかがでしょうか。それとも、何かセル値のデータ変換等をおっしゃているのでしょうか。

質問
bchlr_esmjkさま SEATPLANの実行計測です特に△92% も改善が出現したり、▼212% 悪化も出現しました。 この状況に対するコメントと併せ、いくつかお尋ねしたい点があります>可能な範囲で構いません、是非、ご教示下さい計測条件1.10回ループ2.①元SEATPLAN、②提示されたSEATPLANオリジナル、③そのコンポーネントを私のエクセルにインポートしたもの, の3つ3.従来のSPEEDTESTとbchlr_esmjkさまのSPEEDTEST(NEW) として2つの手段 画像が見えない場合を考慮して転記しておきます(ソフト, SPEEDTEST, SPEEDTEST(NEW) の順) 単位＝秒 ①元SEATPLAN8.2818406②SEATPLANオリジナル0.6090.297③SEATPLANインポート後25.87925.578 (しばらく作表を開始しない)本件の発端としては、8.281 → 0.609に,△92%と 劇的な改善が得られたのは、目をみはるものあり、その反面、③のケースでは、 8.281 → 25.879 と、、▼212% と無残に悪化したことも事実です●気になるのが bchlr_esmjkさまの 以下の3点です。この3点につて是非、お聞かせ下さい1.パソコン性能 2.エクセル性能 3.組み方2.のエクセル性能について 私のエパソコンでは ターゲット②,③について上書き保存が出来ないことです理由は「最新のエクセルで作られているから」というメッセージが出たことです3.の組み方については、詳細トレースはまだですが実行が遅い場合に、特に見えたのは、結果を1セルずつ書き込む制御をしているように見えたことで手法的にそれほど早い手法ではないと直感したことです(失礼)●DICTIONARYを3段階位に重層的に利用されているようですが、その キーとアイテムを教えていただけますか調べた範囲では以下のようになってますが、(TENJYOLIST)KEY＝添乗員名ITEM＝TENJOTMP（＝CLSTENJYOというobjekut)CLSTENJYO(CLSTENJYO) KEY＝添乗員名ITEM＝SEATLIST（＝CLSSEATというobject)(CLSSEAT)TENJYORANKSETMIN_SEATMAX_●(_)の意味も判らない,特別の意味ありですか? (わざと_を削除したら、最小席NO が 0 になった)当方PCは cpu ペンティアム4, 2.53Ghz （32bit) メモリ2GB,windows xp sp3 /VBA97参照はVisual Basic For ApplicationsMicrosoft Excel 8.0 Object LibralyMicrosoft Forms 2.0 Object LibralyMicrosoft Office 8.0 Object Libraly Microsoft Scripting Runtime OLE Automationの6本にレ点があります差し支えなければどのような環境でテストされたのか情報を頂けませんか?リンクhttp://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1186225141http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1386290783よろしくです(^^)

ベストアンサー
なんとなく状況が見えてきた気がします。結論から言うと、コードの問題云々ではなく、グラフィック描画やOSが不安定になっていませんか？（汎用ドライバや、何らかの高速化ユーティリティー等使用していませんか？）ベンチマークで確認しても良いかもしれません。あと、色々と誤った操作を行っていませんか？試してみて欲しいこと。１．OSのクリーンインストール２．ハードに適合する最適なドライバの最新バージョンインストール３．Officeの再インストール４．IEのバージョンが古い場合は最新化５．Excel97で新規作成したブックへのモジュール"インポート"（切り分けが難しくなるので、あなたのコードと混ぜないでね^^）＞コンポーネントを私のエクセルにインポートしたものインポートと表現されていますが、インポートせずにコピペしていませんか？というのも「_を削除したら、最小席NO が 0 になった」とあり、コンパイルエラーならなかったようですので、おそらくOption Explicit文が欠落していると思うのです。（すべてのアンダースコアを削除した場合は問題なく動作するはずです。）＞ターゲット②,③について上書き保存が出来ない保存時に注意メッセージが表示されるのはExcel2007で作成したブックをExcel97で保存しようとしている為であり正常です。＞実行が遅い場合に、特に見えたのは、結果を1セルずつ書き込む制御をしているように見えたことで今回のようにごく少数のセルにしか出力しないのであれば、全く問題ありません。たとえば下記のような10万個のセルに逐次出力する処理ですが、後述の仮想環境でも6秒程度で完了します。（画面描画はONの状態でです。）Variant型配列を用意して１ステップでシートに転記するような手法もあるのですが、出力処理の回数がネックになって、要求される応答速度をクリアできない場合の苦肉の策的な物であって、可読性・保守性を犠牲にしてまで行うようなものではないと考えます。Dim r As Long Dim c As Long For r = 1 To 1000 For c = 1 To 100 Cells(r, c).Value = r * c Next Next＞DICTIONARYを3段階位に重層的に利用されているようですが、その キーとアイテムを教えていただけますか クラスのメンバにDictionaryオブジェクトを持っているだけですので、重層的と言うとちょっとニュアンスがおかしい気がしますが、その様に捉えるのであれば、Dictionaryは2段と言えます。Key・Itemについてはコメントに記載の通りですが。。。添乗員リスト tenjoList ： Key=添乗員名(String型)、Item=ClsTenjoオブジェクト添乗員クラス ClsTenjo ： Key=席のRANK「"S"、"A"、"E"」(String型)、Item=ClsSeatオブジェクト＞(_)の意味も判らない,特別の意味ありですか?クラスのメンバ変数であることを視覚的に捉えやすくするためのもので、これ自体に処理的な意味はありません。（いくつか流派があり、プレフィックス「m_」とする場合や、何も付けないことも多いです。）＞どのような環境でテストされたのか環境は次のようなものですが、仮想環境であなたとほぼ同じ環境を構築してテストしてみましたが、パフォーマンス的に問題ないレベルでした。・ホストPC Windows7 Core2Duo 1.86GHz メモリ2GB Excel2007 実行結果：約80msec・仮想PC WindowsXP SP3 メモリ256MB Excel97 実行結果：約200msec（ウィンドウ最大化時の動きが目で追えるぐらいのモッサリ感です。）不明点等ありましたら、補足をお願いします。