PowerPoint VBAでアウトラインのタイトルのみ取得する方法

このQ&Aのポイント
  • PowerPoint VBAを使用して、アウトラインのタイトルのみを取得する方法について説明します。
  • アウトラインのタイトルのみを取得するために、ActiveWindow.Selection.SlideRange.Shapesを使用します。
  • 具体的なコードの例として、For Eachループを使用してアウトライン内のすべてのスライドを処理し、その中でActiveWindow.Selection.SlideRange.Shapesを使用して各スライド内のテキストボックスを取得します。タイトル部分には「クリックしてタイトルを入力」というデフォルトの値が存在するため、取得したテキストボックスのテキストが「クリックしてタイトルを入力」と一致する場合に、そのテキストを表示します。
回答を見る
  • ベストアンサー

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

アウトラインに表示されている文字(タイトル?)のみ取得したいのですが、 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 を実行すると、アウトラインだけではなく、 テキストボックスにあるすべての値まで取得してしまいます。 アウトラインのタイトル部分のみ表示される文字を取得するコードはありますか? 「クリックしてタイトルを入力」 「・クリックしてテキストを入力」 とスライドにデフォルトで表示されますが、 「クリックしてタイトルを入力」のみの値を取得したいです。

質問者が選んだベストアンサー

  • ベストアンサー
  • s-uzen
  • ベストアンサー率65% (2051/3118)
回答No.2

すみません。 こちらで試した PPT の画像を添付しないで回答をしてしまったので、こちらに添付します。 試したバージョンはPowerPoint 2010 です。 プレースホルダ(何も入力していない際に表示されるテキストはEmptyとなってしまうので)、およびテキストボックスには文字を入力しています。

その他の回答 (1)

  • s-uzen
  • ベストアンサー率65% (2051/3118)
回答No.1

プレースホルダーなどには文字が入力されていないとEnptyとなって、識別ができず何も取得できないようです。 下記で試してみましたが、やりたいことと合っているか不明ですが参考になれば。 プレースホルダ、テキストボックスの値はTextEffect.text と TextFrame.TextRange.text のどちらでも取得できるようなので、取得したものを shape の Type で Placeholder かどうかで判別して、TextBox は無視するようにしてみました。 Sub TextBoxToDebugPrint() Dim slide Dim text1 As String, text2 As String For Each slide In ActiveWindow.Parent.Slides Dim shape For Each shape In slide.Shapes If shape.TextEffect.text <> "" Then If shape.Type = msoPlaceholder Then text1 = shape.TextEffect.text text2 = shape.TextFrame.TextRange.text Debug.Print text1, text2 End If End If Next Next End Sub  

snnqoactvq
質問者

お礼

ご回答ありがとうございます。

関連するQ&A

  • VBA フォントの色を設定するには?

    Sub test() Dim shp As Shape With ActiveWindow.Selection.SlideRange For Each shp In .Shapes shp.TextEffect.FontSize = 9 Next shp End With End Sub これで、現在のシートのテキストのすべてのフォントサイズを設定できたのですが、 全ての色を設定するにはどうすればいいでしょうか? たとえば現在のシートのすべての文字の色を赤(255)にしたい場合は、どういうコードになりますか? ヘルプを見てもよくわかりませんでした。

  • Excel VBA テキストボックスの値の取得

    テキストボックスの値が必要となり参照しようと思い、検索したところdebug.printにある3つの方法がヒットし、試して見ましたが、エラーになります。 テキストボックスの名前にはどれもtxtの文字を含んでいます。 Sub ShapeValue() Dim Shp As Shape For Each Shp In ActiveSheet.Shapes If InStr(Shp.Name, "txt") <> 0 Then Debug.Print Shp.TextFrame.Characters.Text 'オブジェクトは、このプロパティまたはメソッドをサポートしていません。 Debug.Print Shp.TextFrame2.TextRange.Text '指定された値は境界を超えています。 Debug.Print Shp.ShapeRange.TextFrame.Characters.Text 'オブジェクトは、このプロパティまたはメソッドをサポートしていません End If Next Shp End Sub どうすれば取得できるでしょうか?

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

    エクセルVBAでパワーポイントを開き、パワーポイント表に文字を挿入、名前の付けてjpeg保存にする段階で『実行時エラー424オブジェクトが必要です』でエラーになります。丸1日原因を探しましたがわかりません。大変こまっております。どなたかご教授ください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

  • 非表示のテーブルは取得したくない

    全てのテーブル名を取得したくて Sub test() Dim DB As Database Dim T As TableDef Set DB = OpenDatabase(CurrentProject.FullName) For Each T In DB.TableDefs Debug.Print T.Name Next DB.Close Set DB = Nothing End Sub を実行したのですが MSysAccessObjects MSysAccessXML MSysACEs MSysDataCollection MSysIMEXColumns MSysIMEXSpecs MSysNavPaneGroupCategories MSysNavPaneGroups MSysNavPaneGroupToObjects MSysNavPaneObjectIDs MSysObjects MSysQueries MSysRelationships など余計なものまで取得されてしまいます。 ナビゲーションウインドウに表示されている テーブルのみ取得するにはどうすればいいでしょう? ifステートメントで「非表示なら」もしくは 「システムテーブルなら」として、はじくにはどうすればいいでしょう?

  • 「アウトライン表示」ってどこにある?

    ワードのテキストを読んでいたら「アウトライン表示をクリックする」と書いてあってアウトライン表示のボタンの絵が描いてあるのですが、そのようなボタンは画面上表示されていません。 どこにあるんでしょうか? どうしたら表示させられますか? ワード2003です。

  • 画像の取得

    画像の取得 質問させていただきます。 開発環境 VB2010 silverlight4 ドラック&ドロップでファイルを表示させるという処理を作成して、 ボタン押下時にファイルパスを取得したいのですが ファイルのパスのとり方がわかりません。 わかる方いたら教えてください。 ドラック&ドロップの処理 Public Sub DropGo1(ByVal sender As Object, ByVal e As System.Windows.DragEventArgs) txtdrop.Text = String.Empty Dim myDataObject As IDataObject = DirectCast(e.Data, IDataObject) Dim dropFiles() As FileInfo = DirectCast(myDataObject.GetData(DataFormats.FileDrop), FileInfo()) For Each fileItem In dropFiles Dim myImage As Stream = fileItem.OpenRead Dim myImageSource As New BitmapImage myImageSource.SetSource(myImage) Image1.Source = myImageSource myImage.Close() imageTextBlock.Text = fileItem.Name txtdrop.Text = fileItem.Name Next End Sub よろしくお願いいたします。

  • htmlソースをテキストボックスに表示させて20行目の10文字の数字を取得したい。

    恐れ入ります。 http://www.microsoft.com/japan/msdn/vbasic/migration/tips/WebClient/ このページのコードを使わせてもらって htmlソースをテキストボックスに表示することはできました。表示させたテキストボックスの20行目の10文字の数字を取得したいのですが、どのようにすれば取得できるんでしょうか?val関数も1行目だけみたいですし・・・。ちなみに20行目は var strReqHomeID = "0000100012"; という具合になっていて  0000100012 を取得したいのです。 -------------------以下コード---------------- Imports System Imports System.Text Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try Dim download As New Net.WebClient() Dim temp As Byte() = download.DownloadData(TextBox1.Text) Dim change As Text.Encoding = Encoding.Default TextBox2.Text = change.GetString(temp) Dim filename As String = System.IO.Path.GetFileName(TextBox1.Text) If filename = "" Then filename = "Temp.html" End If Dim strPath = My.Computer.FileSystem.SpecialDirectories.Desktop strPath = strPath + "\" + filename download.DownloadFile(TextBox1.Text, strPath) WebBrowser1.Navigate(TextBox1.Text) Catch ex As Exception Throw End Try End Sub

  • 現在開いてるIEのタイトルを取得するには?

    Sub test() Dim shl As Object Dim wnd As Object Set shl = CreateObject("Shell.Application") For Each wnd In shl.Windows() Debug.Print wnd.LocationURL Next Set shl = Nothing End Sub ----------------------------------------- これを実行するとIEのURLは取得できますが 画像のようにタイトル部分の文字列を取得したいです。 LocationURLをLocationnameに変えたらエラーになりました。 ご教授よろしくお願いします。

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

    vbsで複数pptx内の文字列抽出してxls出力する処理で 1つめのpptxのopen~文字列抽出~closeはうまくいくのですが 2つめのpptxをうまくobject生成できません。 デバッグ用コメントで確認すると2つめpptxを瞬時にopen~close したあとにForNextの文字列抽出が動いているようで For文で"オブジェクトがありません"となってしまいます。 どなたか解決方法をご教授願えませんでしょうか。 Sub GrepPpt(objPptFile) Dim sld,shp,rng,find_rng,tbl,find_cell Set objPpt = CreateObject("PowerPoint.Application") objPpt.Visible = True Set filex = objPpt.Presentations.Open(objPptFile) For Each sld In objPpt.ActivePresentation.Slides ←ここで For Each shp In sld.Shapes If shp.HasTextFrame Then For columnx = 0 To keywordsx.Count - 1 Set rng = shp.TextFrame.TextRange Set find_rng = rng.Find(keywordsx(columnx)) If Not find_rng Is Nothing Then arraylstx.add rng & vbTAb & shp.Name & vbTab &~(割愛) Exit For End If Next Else ~(Table検索割愛) End If Next Next filex.Close objPpt.Quit Set objPpt = Nothing End Sub

  • Visual Sutudio 2003で、文字を反転させるプログラムが正しく動きません。

    Visual Sutudio 2003で、困っています。 TextBox1に、文字を入力してButton1をクリックすると、入力された文字が反転されてLabel3に、表示されるプログラムを作ってみたのですが、上手く動きません。 例えば、「TextBox1」と入力してボタンをクリックすると、「1xoBtxeT」と表示させたいのですが、「1ote」と一文字置きに表示されてしまいます。 「Button1をクリックした時のプログラム」 Dim moji, kekka As String Dim i As Integer Label3.Text = "" moji = TextBox1.Text Label3.Text = moji.Substring(moji.Length - 1, 1) For i = 2 To moji.Length  Label3.Text &= moji.Substring(moji.Length - i, 1)  i = i + 1 Next End Sub 正しく表示させるには、どうすればいいのでしょうか?分かる方、宜しくお願いします。

専門家に質問してみよう