• 締切済み

vbsで複数pptxから文字列抽出したい

unokwaveの回答

  • unokwave
  • ベストアンサー率58% (966/1654)
回答No.1

dim pOj と事前に宣言しておき、 For Each sld In objPpt.ActivePresentation.Slides の箇所を For Each pOj In ObjPpt.Presentations For Each sld In pOj.Slides として、filex.Closeの前にもう一つ Next を追加してみて下さい。

tomtom_24
質問者

お礼

unokwaveさんフォロー頂きありがとうございます。 改修したところ2つめpptx時のエラー発生はなくなりましたが やはり2つめpptxを瞬時にopen~closeしたあとに ForNextの文字列抽出が動いているようで For Each pOj In ObjPpt.Presentations文をそのまま抜けてしまい 2つめpptxに対する文字列抽出がされません。 2つのpptxファイル検索の間にtxtファイル検索があるとうまくいくので 現在sleep挿入を試みてもいますが根本原因ではなさそうなので解決には至っておりません。

この回答がついた質問に戻る
  1. カテゴリ
  2. [技術者向] コンピューター
  3. その他([技術者向] コンピューター)

関連するQ&A

  • 完全に一致する文字列を検索するマクロ文

    For Each rng In Range("B1:B21200") If rng.Value <> "" Then Set out = Range("A1:A2100").Find(rng.Value) If Not out Is Nothing Then igo = out.Address End If Do While Not out Is Nothing out.Font.ColorIndex = 3 Set out = Range("A1:A2100").FindNext(out) If igo = out.Address Then Exit Do End If Loop End If Next このマクロはRange("B1:B21200")でRange("A1:A2100")を検索し一致する文字列を赤文字（A列の文字）にするのですが このマクロだと、あいまいな検索になってしまいます。 完全に一致する文字列のみ赤文字にするマクロ文を知りたいのですが。

  • 社員名簿に写真を表示させるマクロを教えて下さい！

    社員名簿の作成で困っています。 セルC4、C9、C14、C19…とE4、E9、E14、E19…に社員コードを入力すると、所属・氏名・入社年月日・勤続年数がVLOOKUP関数で表示されるように作成しました。 写真も表示されるようにいろいろな所を検索して、マクロをコピーしてみました。 表示はされるのですが、うまく表示されません。 表示場所は、B4:B8、B9:B13…と社員コードの左側の結合セルです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim TgRng As Range Dim Rng As Range Dim Shp As Shape Const PathN = "画像フォルダの場所" Set TgRng = Intersect(Range("C4,C9,C14,C19,C24,C29,E4,E9,E14.E19,E24,E29"), Target) If TgRng Is Nothing Then Exit Sub For Each Rng In TgRng For Each Shp In ActiveSheet.Shapes If Not Intersect(Shp.TopLeftCell, Rng.Offset(0,-1).MergeArea) Is Nothing Then Shp.Delete End If Next If Not IsEmpty(Rng.Value) And Dir(PathN & Rng.Value & ".jpg") <> "" Then Set Shp = ActiveSheet.Shapes.AddPicture(PathN & Rng.Value & ".jpg", False, True, 50, 50, 50, 50) Shp.LockAspectRatio = msoFalse Shp.Top = Rng.Offset(0,-1).Top Shp.Left = Rng.Left Shp.Height = Rng.Offset(0,-1).Height Shp.Width = Rng.Offset(0,-1).MergeArea.Width Else If Not IsEmpty(Rng.Value) Then _ MsgBox "ファイルが見つかりません。", vbExclamation End If Next Set Shp = Nothing Set TgRng = Nothing End Sub マクロは初心者です。 どこを直したらよいか、どなたか教えて下さい。 よろしくお願いします。

  • アウトラインに表示されている文字　取得したいのです

    アウトラインに表示されている文字（タイトル？）のみ取得したいのですが、 Dim sld As Slide Dim shp As Shape Sub test() For Each sld In ActivePresentation.Slides sld.Select For Each shp In ActiveWindow.Selection.SlideRange.Shapes Debug.Print shp.TextEffect.Text Next shp Next sld End Sub を実行すると、アウトラインだけではなく、 テキストボックスにあるすべての値まで取得してしまいます。 アウトラインのタイトル部分のみ表示される文字を取得するコードはありますか？ 「クリックしてタイトルを入力」 「・クリックしてテキストを入力」 とスライドにデフォルトで表示されますが、 「クリックしてタイトルを入力」のみの値を取得したいです。

  • エクセルVBAでパワーポイントを開き、表に文字を挿入jpeg保存時の実行時エラー

    エクセルVBAでパワーポイントを開き、パワーポイント表に文字を挿入、名前の付けてjpeg保存にする段階で『実行時エラー424オブジェクトが必要です』でエラーになります。丸１日原因を探しましたがわかりません。大変こまっております。どなたかご教授くださいm(__)m Sub Macro() Dim objPPT As Object '参照設定すれば　 　　PowerPoint.Application Dim myPre As Object 'PowerPoint.Presentation Dim Sld As Object 'PowerPoint.Slide Dim Shp As Object 'PowerPoint.Shape Dim myRow As Object 'PowerPoint.Row Dim myCell As Object 'PowerPoint.Cell Dim mySht As Worksheet Dim n As Long Dim j As Long Dim fd As FileDialog 'ファイルダイアログ '任意のファイル呼び出し Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = True .Filters.Add "PowerPointファイル", "*.ppt; *.pps; *.pptx; *.pptm", 1 If .Show <> -1 Then Exit Sub End With Set mySht = ActiveSheet 'パワーポイント起動 Set objPPT = CreateObject("PowerPoint.Application") objPPT.Visible = True i = mySht.Range("A" & Rows.Count).End(xlUp).Row + 1 '行カウンタ初期化 For n = 1 To fd.SelectedItems.Count '取得したファイルの情報のオブジェクトの数 'パワポファイル開く Set myPre = objPPT.Presentations.Open(fd.SelectedItems.Item(n), True) For Each Sld In myPre.Slides 'スライドループ For Each Shp In Sld.Shapes '図形ループ If Shp.HasTable Then '表発見 For Each myRow In Shp.Table.Rows '行ループ For Each myCell In myRow.Cells 'セルループ myCell.Shape.TextFrame.TextRange.Text = "おはよう" Next Next End If Next Next Next n 'ファイルの保存（ここで実行エラー） ActivePresentation.SaveAs Filename:="C:\power.jpg", FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse 'パワポファイル閉じる myPre.Close objPPT.Quit 'パワーポイント終了 Set myCell = Nothing Set myRow = Nothing Set Shp = Nothing Set Sld = Nothing Set myPre = Nothing Set objPPT = Nothing MsgBox ("処理が終了しました") End インデントがうまく表示されないので、ホームページにアップロードしました。よろしくお願いいたします。 http://www.geocities.jp/tmp025tmp/test.html

  • GetOpenFilenameを使用し、複数行のデータを抽出について

    エクセルVBA初心者です。 いろいろ調べましたが、うまくいかずご教授頂ければとお聞きします。 よろしくお願いします。 テキストファイル10万行からなるデータが入っています。 「aaa」と文字列を検索し、その下１０行を抽出したいのです。 Sub 抽出() fname = Application.GetOpenFilename(FileFilter:="(*.*),[*.*]", Title:="data?", MultiSelect:=False) if fname For Input As #1 Do Line input as #1 If InStr(data, "aaa") > 0 Then For i = 1 To 10 Cells(i, 1).Value = data Next End If Loop Until EOF(1) Close #1 End Sub

  • 【VBScript】文字列抽出&テキスト生成

    QNo.9089814の内容と被ってしまうのですが、 アドバイスいただければと思います。 まず以下のプログラムがあります。 現状kensyo.vbsに任意のテキストファイルをドラッグすると、 そのファイルのフルパスを表示した後、 内容を出力する処理となっています。 途中InputBoxを起動し、抽出したい文字列を入力し、 その文字列を変換します、というMsgBoxを加えています。 MsgBoxで「はい」を選択したら、読み込んだテキストファイルから 文字列が含まれる行のみ別名のテキストファイルに抽出したいと考えています。 テキストファイルを読み込む動作までは出来たのですが、 以降の処理をどうすればいいのか、行き詰ってしまいました。 恐れ入りますが、ご教示いただけますと幸いです。 ================================================== <kensyo.vbs> Option Explicit Dim intc Dim strFile, strArguments, strInput, lonmsgbox, objFSO, objOpen, strText intc = 0 If WScript.Arguments.Count = 0 Then WScript.Echo "引数が指定されていません。" Else For Each strArguments In WScript.Arguments intc = intc + 1 strFile = strArguments Next If intc > 1 Then MsgBox "2つ以上のファイルが指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" Else WScript.Echo strFile strInput = InputBox("抽出したい文字列を入力してください。") lonmsgbox = MsgBox (strInput & "を抽出しました。" & vbCr _ & strInput & "を変換しますか？", 4 + 32 + 0, "確認") If lonmsgbox = 6 Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objOpen = objFSO.OpenTextFile(strFile, 1) Do Until objOpen.AtEndOfStream = True strText = objOpen.ReadAll WScript.echo strText Loop objOpen.Close Set objFSO = Nothing Else MsgBox ("処理を中断します。") End If End If End If ==================================================

  • 文字列の抽出

    指定したファイルの中から'<'と'>'とで囲まれた部分文字列を抽出したいのですが方法がわかりません。どのようにしたらできるでしょうか？ ＊ファイルは制御コードが混じっているのでバイナリとして扱わないといけないかもしれません。 よろしくお願い致します。 ------------------------------------------------- open(IN, "test.dat"); open(OUT, "> out.txt"); binmode(IN); while (<IN>) { /^<(\w+)>$/; print OUT "$1\n"; } close(IN); close(OUT);

    • ベストアンサー
    • Perl
  • 複数セル参照で塗りつぶしを変更する

    WIN:XP Off:2003 お願いします。　添付した図は入出金表です。 列Hに数値が入力されると列Eのセルが青く塗りつぶされます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim aCell As Range Set Rng = Intersect(Target, Range("H:H")) If Rng Is Nothing Then Exit Sub For Each aCell In Rng If aCell.Value > 0 Then aCell.Offset(0, -3).Interior.ColorIndex = 17 Else aCell.Offset(0, -3).Interior.ColorIndex = xlNone End If Next aCell Set Rng = Nothing End Sub ここまでは出来たのですが、列Iに入力された時に列Eが赤に塗りつぶされるにはどうしたらいいでしょうか？ 同じ行のHとIに同時に数値が入る事はありません。 どうかお願い致します。

  • VBSで、日本語文字列の抽出が、うまくいきません。

    VBSで、日本語文字列の抽出を行いたいのですが、日本語がうまく動作しません。 もし、対処法などがあれば、教えていただければ、と思います。 プログラムとしては、あるファイルの中から、ある文字列（メールから、名前を抜き出す、など）を抽出して、 別ファイルに書き出すことをしたいのですが、 英数字（半角）では動作するのですが、日本語（全角）では動作ができません。 エンコーディングなどが問題だと思うのですが、プログラムがあまり分からないため、困っています。 良い解決法などあれば、教えていただければ、と思います・・・。 ----（現在のファイル：test.vbs）----------- Const ForReading = 1,ForWriting = 2,ForAppending = 8 '定数の指定 Set Fs = WScript.CreateObject("Scripting.FileSystemObject") sFile = InputBox("検索するファイルのパス") sWord = InputBox("検索する文字列") Set oTs1 = Fs.OpenTextFile(sFile,ForReading) Set oTs2 = Fs.CreateTextFile("result.csv",True) oTs2.WriteLine "ファイルパス= " & sFile oTs2.WriteLine "検索文字= " & sWord oTs2.WriteBlankLines 1 Do Until oTs1.AtEndOfStream sLine = oTs1.ReadLine If InStr(sLine,sWord)<>0 Then dim i'検索文字列 dim j'半角スペースの位置 dim Res'書き出す内容 dim n,m i= InStr(sLine,sWord) j = InStr(i, sLine, Chr(32)) n = j-i Res = Mid(sLine, i, n) oTs2.Write "Line:" & oTs1.Line - 1 & ", " & Res & vbCrLf End If Loop oTs1.Close oTs2.Close MsgBox "書き出し完了" ---------------------------------------------------------------

  • VBA 複数のファイルの特定の列だけ取得してマージ

    お世話になっております。 VBAで、複数のCSVファイルの特定の列だけを抽出して別のCSVファイルにマージする方法を探しています。 例えば、マージフォルダに1000のCSVファイルがあります。 1000あるファイルのA列とC列だけを抽出して、 それを別の「マージ.CSV」というファイルにA列とB列にマージして一つにしたいのです。 1000のファイルにはA~Qまで値が入っていて、A~Q列の値全て取り込みマージするとデータが重くなってしまうのです。 Unionメソッドを仕様して列を選択するのかなと思うのですが。。。 現在、こちらのコードを参考にしています。 わかる方いましたらよろしくお願いいたします。 Sub csvmerge() wpath = Range("B3") wfile = Dir(wpath & "\") flag = 0 Do While wfile <> "" If InStr(wfile, ".csv") Then flag = flag + 1 If flag = 1 Then FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv" Open ThisWorkbook.Path & "\output.csv" For Output As #1 Close #1 End If Open ThisWorkbook.Path & "\output.csv" For Append As #1 Open wpath & "\" & wfile For Input As #2 Do Until EOF(2) Line Input #2, w_str Print #1, w_str Loop Close #2 Close #1 End If wfile = Dir() Loop MsgBox "マージ完了", vbInformation End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する