- 締切済み
PowerPoint2003でノートを一括削除するVBA
調べたところ Sub test() Dim i As Integer i = ActivePresentation.Slides.Count For i = 1 To i With ActivePresentation.Slides(i).NotesPage .Shapes.Placeholders(2).TextFrame.TextRange = "" End With Next i End Sub というマクロでいけるそうなのですが、幾つか試すと 「実行時エラー '2147188160(80048240)」': Placeholders(不明なメンバー）：範囲外の整数2は次の有効な範囲にありません:1から１へ」 というエラーで停まるものがあります。 これの回避方法をご存知の方がいたら教えてください。
- torinosora
- お礼率77% (42/54)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- ja7awu
- ベストアンサー率62% (292/464)
関連するQ&A
- パワーポイントVBAでグラフのサイズ・位置を統一
パワーポイントVBAに貼付けた複数のグラフサイズを統一したいと思っています。 1～20枚目のスライドに、それぞれ２つのグラフが貼付けてあります。 全てのグラフサイズ・位置を統一したいと思い、以下の様なVBAを書いてみました。 ---------- Sub 表サイズの統一() Dim myTop1, myLft1, myHgt1, myWdt1, cnt, i, myTop2, myLft2, myHgt2, myWdt2 With ActivePresentation.Slides(1).Shapes(1) myTop1 = .Top myLft1 = .Left myHgt1 = .Height myWdt1 = .Width End With With ActivePresentation.Slides(1).Shapes(2) myTop2 = .Top myLft2 = .Left myHgt2 = .Height myWdt2 = .Width End With cnt = ActivePresentation.Slides.Count For i = 2 To cnt With ActivePresentation.Slides(i).Shapes(1) .Top = myTop1 .Left = myLft1 .Height = myHgt1 .Width = myWdt1 End With Next For i = 2 To cnt With ActivePresentation.Slides(i).Shapes(2) .Top = myTop2 .Left = myLft2 .Height = myHgt2 .Width = myWdt2 End With Next End Sub ---------- 各スライドにある１つ目のグラフのサイズは統一出来たのですが、２枚目のグラフは何の変化もおきません。 どこが悪いのか、どなたかご教示頂ければ幸いです。 どうぞよろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- PowerPoint2010のマクロに関して
現在, パワポのマクロをVBAで作成しているのですが, ネット上でも資料が少なくて困っています。 マクロの内容は、ページ内に 総ページ数から現在のページがどの程度進んでいるかを図で表すようなもの を設置するといったものです。 図は、総ページ3ページなら ■□□ ← 1ページ ■■□ ← 2ページ といった感じです。 現在、四角を配置することまではできたのですが、 その四角の色を変更することができなくて迷っています。 ソースコードは以下のように書いています。 Sub ページ進行表示() Dim PCount Dim Color1, Color2 Color1 = RGB(255, 0, 0) Color2 = RGB(255, 180, 180) ActivePresentation.Slides(1).Select PCount = ActivePresentation.Slides.Count For i = 1 To PCount ActivePresentation.Slides(i).Select For j = 1 To PCount ActivePresentation.Slides.Item(i).Shapes.AddShape(msoShapeRectangle, 10 + (j * 10), 10, 5, 20).Select ActivePresentation.Slides.Item(i).Shapes(i).Fill.ForeColor = Color Next Next End Sub 追加した図形を選択して色を変更する方法を教えてください
- ベストアンサー
- Visual Basic
- vba スライドに図形を挿入し文字を入力するには
一番最後のスライドに、図形を挿入するところまでは出来たのですが その図形に文字を表示するにはどうすればいいでしょうか？ Sub test() Dim myDocument As Variant i = ActivePresentation.Slides.Count Set myDocument = ActivePresentation.Slides(i) myDocument.Shapes.AddShape Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=100, Height:=50 myDocument.Shapes.Title = "a" myDocument.Shapes.Text = "a" End Sub まではできたのですが、 myDocument.Shapes.Title = "a" myDocument.Shapes.Text = "a" がエラーになります。 別に図形ではなくてもテキストボックスが挿入できればそれでいいのですが、 図形の挿入の仕方しかわかりませんでした。
- ベストアンサー
- PowerPoint（パワーポイント）
- パワーポイントＶＢＡで
http://q.hatena.ne.jp/1144314367 これと同じような事をしたくて、 Sub TextBoxToDebugPrint() Dim slide For Each slide In ActiveWindow.Parent.Slides Dim shape For Each shape In slide.Shapes Debug.Print shape.TextFrame.TextRange.Text Next Next End Sub を張り付けたのですが、一部の文字は取得できますが、 実行時エラー -2147024809 指定された値は境界を超えています。 と言うエラーが発生し、止まってしまいます。 どもオブジェクトがどういう意味のエラーを出してるのかわからないのですが どういう意味でしょうか？
- 締切済み
- PowerPoint（パワーポイント）
- エクセルVBAでテキストボックスに文字
Excel2016です。 ワークシート上に配置した、図形の「テキストボックス」に文字を入れるVBAについての質問です。 下記のTEST01では期待通り文字が入りますが、これはテキストボックスをSelectしなければなりません。 TEST02ならSelectせずにOKかと思ったら実行時エラーとなりました。 どのように修正したらよろしいのでしょうか？ Sub TEST01() Sheets(“Sheet1”).Shapes.Range(Array("TextBox 3")).Select Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = "TEST/TEST/2020" Selection.ShapeRange.TextFrame2.TextRange.Font.Name = "Meiryo UI" Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue End Sub Sub TEST02() With Sheets(“Sheet1”).Shapes.Range(Array("TextBox 3")) .ShapeRange.TextFrame2.TextRange.Characters.Text = "TEST/TEST/2020" .ShapeRange.TextFrame2.TextRange.Font.Name = "Meiryo UI" .ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue End With End Sub
- ベストアンサー
- Excel（エクセル）
- ＶＢＡ超初心者です。
プログラミング超初心者です。 下のは、pptxのスライド１枚目に表示されているすべての文字・色・大きさを１文字ずつ取ってくるマクロです。 これを改造して、 (1)pptxファイル内のすべてのスライドに対して (2)"文字 色 大きさ"の形式で (3)結果をテキストファイルに書き出す（スライド１枚につきテキストファイル１つでも、全部まとめてテキストファイル１に書き出すでもＯＫ）（さらにシェイプ毎に分かれてくれたら尚嬉しい） にはどうすればいいのでしょうか？ 改造後のソースを書いてくれると助かります。注文の多い我儘な質問ではありますが、よろしくお願いします。 ------------------------------------------------------------ Sub Sample1() '1文字ずつ文字情報取得 Dim myShape As Shape Dim myCharacter As Object 'スライド1のシェイプを処理 For Each myShape In ActivePresentation.Slides(1).Shapes With myShape 'テキストがあるシェイプを処理 If .TextFrame.HasText Then For Each myCharacter In .TextFrame.TextRange.Characters MsgBox "テキスト：" & myCharacter.Text & vbCrLf & _ "フォントカラー：" & myCharacter.Font.Color & vbCrLf & _ "フォントサイズ：" & myCharacter.Font.Size Next End If End With Next End Sub --------------------------------------------------------------
- ベストアンサー
- その他（プログラミング・開発）
- ExcelのデータをPPTにエクスポートしたいです(VBA初心者)
ExcelのデータをPPTにエクスポートしたいです(VBA初心者) ネット検索などをして、下記の手順でエクスポートすることまではできたのですが、 これだと全てのセルデータがPPTの1つのテキストに入ってしまいます。 希望しているのは、セルごとにエクスポート先の テキストボックスを分けたいのですが、 ここから先が分かりません。 どなたかご教授いただけませんか。 よろしくお願いします。 <Excel> A B C D E １ 会社名(1) 住所(1) 担当者(1) ２ 会社名(2) 住所(2) 担当者(2) ３ 会社名(3) 住所(3) 担当者(3) <PPT> ・Sheet1 テキストボックス1 会社名(1) テキストボックス2 住所(1) テキストボックス3 担当者(1) ・Sheet2 テキストボックス1 会社名(2) テキストボックス2 住所(2) テキストボックス3 担当者(2) --------------------------------------- Sub ExceltoPowerPoint() Dim objRng As Range Dim varRng As Variant Dim intSNum As Integer Dim i, j As Integer Dim PpApp As PowerPoint.Application Dim PpPrs As PowerPoint.Presentation Set objRng = Worksheets("Sheet1").Range("A1:C5") varRng = objRng.Value Set objRng = Nothing Set PpApp = CreateObject("PowerPoint.Application") Set PpPrs = PpApp.Presentations.Add PpApp.Visible = True intSNum = 1 For i = 1 To UBound(varRng, 1) PpPrs.Slides.Add i, ppLayoutBlank PpPrs.Slides(i).Shapes.AddTextbox msoTextOrientationHorizontal, 0, 0, 710, 540 Next For i = 1 To UBound(varRng, 1) For j = 1 To UBound(varRng, 2) With PpPrs.Slides(intSNum).Shapes(1).TextFrame.TextRange If j = UBound(varRng, 2) Then .Text = .Text & CStr(varRng(i, j)) & vbNewLine intSNum = intSNum + 1 Else .Text = .Text & CStr(varRng(i, j)) & vbNewLine End If End With Next Next For i = 1 To UBound(varRng, 1) With PpPrs.Slides(i).Shapes(1).TextFrame.TextRange .Font.NameAscii = "Arial" .Font.NameFarEast = "ＭＳ Ｐゴシック" .Font.NameOther = "Arial" .Lines(1).Font.Size = 10 '1行目 .Lines(2).Font.Size = 30 '2行目 .Lines(3).Font.Size = 20 '3行目 End With Next MsgBox "処理が終了しました。" Set PpPrs = Nothing Set PpApp = Nothing End Sub ---------------------------------------
- 締切済み
- オフィス系ソフト
- スライドのタイトルをフォームのコンボボックスに
パワーポイント2003 スライドのタイトルをフォームのコンボボックスに表示させたい http://www.moug.net/faq/viewtopic.php?t=62643のスライドマスタのコンボボックスではなく、 ＶＢＡのフォームのコンボボックスで同じことがしたいのですがうまく出来ません。 Private Sub ComboBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim mySld As Slide If ComboBox1.ListCount = 0 Then ComboBox1.Clear With Application.SlideShowWindows(1).Presentation For Each mySld In .Slides With mySld.Shapes If .HasTitle Then If .Title.TextFrame.HasText Then ComboBox1.AddItem .Title.TextFrame.TextRange.Text GoTo tugi End If End If End With ComboBox1.AddItem mySld.Name tugi: Next ComboBox1.ListRows = .Slides.Count End With End If End Sub をフォームモジュールに張り付けたのですが With Application.SlideShowWindows(1).Presentation の部分で、 実行時エラー-2147188160(80048240) と言うエラーになります。 http://www.tech-archive.net/Archive/Office/microsoft.public.powerpoint/2004-04/3228.html を見ても全くわかりません。 フォーム上では無理なのでしょうか？
- ベストアンサー
- オフィス系ソフト
- PowerPointVBA複数ファイル一括について
現在開いているpptと同フォルダ内の全てのpptファイルに対して、 1ページ目のサブタイトルに日付を一括で入れるマクロを作成したいのです。 下記のように作成してみたのですが、いちおう全ファイルに希望通りの個所に希望の文字列が入るのですが、実行にものすごく時間がかかりました。。 ステップインで確認すると、"Presentations.Open FileName:="の行で、Forループの繰り返し毎に、全ファイル開いてしまっているようで。。 一般の初心者で、見よう見まねでやっていまして、ヘルプやWeb検索でも、どうしても解決策を見いだせませんでした。 どなたか、ご教示いただけませんでしょうか。 よろしくお願いいたします。_(_ _)_ ------------------------------------------------------------ Sub AddDatetoAllPPT() Dim todaydate As String todaydate = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日" Dim myShape As Shape Dim FSO As Object, Files As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Set Files = FSO.GetFolder(ActivePresentation.Path).Files For Each File In FSO.GetFolder(ActivePresentation.Path).Files Presentations.Open FileName:=ActivePresentation.Path & "\" & File.Name Set myShape = ActivePresentation.Slides(1).Shapes("サブタイトル 2") myShape.TextFrame.TextRange.Text = todaydate ActivePresentation.Saved = True Next End Sub
- ベストアンサー
- Visual Basic
- WORD ＶＢＡのShapesのこと
昨日TTakさんから下記のマクロを御教授いただいて助かっているのですが、特定のShapesを除外して下記を実行する方法があれば教えていただけないでしょうか。 Private Sub CommandButton1_Click() Dim myf As String myf = "ここに画像ファイルまでのパスとファイル名を入れる" With ActiveDocument For i = 1 To .Shapes.Count .Shapes(i).Fill.UserPicture myf Next i End With End Sub
- ベストアンサー
- オフィス系ソフト
補足
ありがとうございます。早速試してみたのですが、残念ながらうまくいきませんでした。 （同じエラー内容でした・・・）