VBAでエクセルに入力された複数のセルの文字列をパワポに一つずつ文字の置き換えを行いたいです。
ネットから参考になりそうなコードを拾ったのですが、下から5行目のテキストを取得のところでデバッグしてしまい、先へ進めません…
どなたかお力を貸して頂けないでしょうか。
Public Sub ReplaceTextText()
'--- プレゼンテーションを開く ---'
Dim pptObj As PowerPoint.Application
Dim pptPrs As PowerPoint.Presentation
Set pptObj = CreateObject("PowerPoint.Application")
pptObj.Visible = True
Set pptPrs = pptObj.Presentations.Open("ファイルパス")
'--- 置換前の文字列 ---'
Dim orgStr As String
orgStr = "置き換え前の文字"
'--- 置換後の文字列 ---'
Dim replacedStr As String
replacedStr = "置き換え後の文字"
'--- 文字列を置換する ---'
Dim slideObj As Slide
Dim shapeObj As Variant
Dim textTmp As String
For Each slideObj In pptPrs.Slides
For Each shapeObj In slideObj.Shapes
Call replaceShapeText(shapeObj, orgStr, replacedStr)
Next shapeObj
Next slideObj
'--- ファイルを閉じる ---'
'pptPrs.Close
End Sub
'--- ShapeオブジェクトのTextを置換する ---'
Private Sub replaceShapeText(shapeObj As Variant, orgStr As String, replacedStr As String)
'--- グループの場合は再度各要素に対して置換を実行 ---'
If (shapeObj.Type = msoGroup) Then
Dim shapeTmp As Variant
For Each shapeTmp In shapeObj.GroupItems
Call replaceShapeText(shapeTmp, orgStr, replacedStr)
Next shapeTmp
Else
Dim textTmp As String
'--- テキストを取得 ---'
textTmp = shapeObj.TextFrame.TextRange.Text
'--- テキストを置換 ---'
textTmp = Replace(textTmp, orgStr, replacedStr)
'--- テキストを再度設定 ---'
shapeObj.TextFrame.TextRange.Text = textTmp
End If
End Sub
No.1
- 回答日時:
こんばんは、
'--- テキストを取得 ---'
textTmp = shapeObj.TextFrame.TextRange.Text
ここで実行時エラーが発生しているのでしょうか?
shapeは、色々と種類があります。
コードでは、グループ化したシェイプに対しての実行プロセスは存在しますが、TextRange.Textを持たないシェイプに対してのプロセスがありません。
つまり、スライド内にテキストを入れられないシェイプが存在する為では無いかと思います。
シェイプのタイプは、こちらを参考にしてください。
https://www.relief.jp/docs/excel-vba-list-msosha …
乱暴な回避方法で良ければ、元々テキストがないシェイプなので
エラーが返される
textTmp = shapeObj.TextFrame.TextRange.Textの前に
On Error Resume Next で無視する事で回避できると思います。
(乱暴で無い回避方法は.Typeで置き換えたいシェイプの種類を指定します)
ただし、掲示のコードを検証していませんので、見込みと違うエラーだった場合は、ごめんなさい。
早速ご回答ありがとうございます。
VBA初心者で申し訳ありません。
試してみます!
"置き換え前の文字"をパワポ内に見つけることが出来ないということでしょうか。
パワポ内に特定の文字を検索して、エクセルに入力された文字列を一つずつ置き換えていきたいのですが…
一つが置き換え出来ればfor〜nextで繰り返しの作業に編集すればできるのかな?と安易な考えです。
No.2
- 回答日時:
こんばんは
エラーの内容の記述がないので推測になってしまいますが、すでに、No1様のご指摘にあるようにテキストを持っていないシェイプでエラーになっているものと想像しました。
HasTextプロパティで、テキストがあるかを調べられますので、あるものだけを処理の対象になさればよろしいのではないでしょうか。
https://docs.microsoft.com/ja-jp/office/vba/api/ …
たとえば、以下でエラー回避をできませんか?
If shapeObj.TextFrame.HasText Then
' *** 置き換えの処理
End If
No.3
- 回答日時:
こんにちは
>置き換え前の文字"をパワポ内に見つけることが出来ないということでしょうか。そうです。
shapeオブジェクト内のTextRangeを見つけられないと言う事です。
shapeオブジェクトには、TextRangeプロパティを持っていないものもあります。これはExcelでも同じです。
>パワポ内に特定の文字を検索して、エクセルに入力された文字列を一つずつ置き換えていきたいのですが…
>一つが置き換え出来ればfor〜nextで繰り返しの作業に編集すればできるのかな?と安易な考えです。
>for〜nextで繰り返しの作業に編集すれば
これは、正しいと思います。
しかし、対象のオブジェクトに種類や制限(保護設定みたいな)がある場合、命令が実行できない、
対象メソッドやプロパティが見つからない、受け付けないなどのエラーが発生します。
示されているコードで説明するとスライドはスライドコレクションのスライドオブジェクトです。
(Excelで例えるとWorksheetsのWorksheet)
個々のオブジェクトをインデックスや名前で指定する事が出来ますが、
コードではコレクションの中をFor Eachでオブジェクトを取得しています。
Set pptObj = CreateObject("PowerPoint.Application")
Set pptPrs = pptObj.Presentations.Open("ファイルパス")
For Each slideObj In pptPrs.Slides
Excelのシートで例えると
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:=ファイルパス)
For Each sheetObj In WB.Worksheets
この、オブジェクトの中にshapeオブジェクトが複数ある場合、
1つ1つのshapeを取得する場合、ShapesコレクションからFor Eachで取得できます。
続く
No.4ベストアンサー
- 回答日時:
続き
For Each shapeObj In slideObj.Shapes
スライドオブジェクトのシェイプコレクションからループでシェイプを取得
これは、スライドやシートを取得する時と似ています。
しかし、コレクションからオブジェクトをFor Eachなどで取得すると
コレクション内すべてのオブジェクトが順に取得される為、
取得されるオブジェクトに種類や保護設定などがある場合を想定できる時は
.Type .Nameなどや該当プロパティを判定する 分岐処理が必要になります。
なぜエラーが出るかご理解いただけましたでしょうか。
対処方法
テキストを持つすべてのシェイプに対して処理を行いたいのであれば
(目的がテキストの置き換えなので)
#2様の方法が最も良いと思います。
On Error Resume Next
これも行けるとは思いますが、デバッグ時、エラー特定の妨げになったり
内部的にエラーを黙認する事が気になります。
.HasTextが100点だとすると30点くらいの方法です。
私の場合、取り敢えずで使う事はあります。
シェイプの種類によって処理を分けたい場合は、
If shapeObj.Type = msoTextBox Then みたいに
シェイプのタイプを限定して実行するのも良いと思います。
(文字置き替えたくないシェイプなどを他のタイプで追加する事が出来ます)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード 4 2023/01/01 07:32
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Visual Basic(VBA) outlook マクロが終了しません。 1 2022/09/02 11:14
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Visual Basic(VBA) Excel VBA メール作成について 本文の中にExcel でコピーした図を上下に2つ 貼り付けを 2 2023/06/14 01:48
- Visual Basic(VBA) 実行時エラー´5854´ 文字列型パラメーターが長すぎます。 3 2023/06/08 21:17
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
worksheetFunctionクラスのVloo...
-
「Columns("A:C")」の列文字を...
-
textBox isNot Nothing とは
-
Excelでフィルタをかけると警告...
-
実行時エラー 3265「要求された...
-
AccessVBAで「dim dbs as datab...
-
VBAで既に開いている別アプリケ...
-
テキストボックス中の文字列の...
-
VB6 エクセルに画像貼り付け
-
EXCEL VBA COLLECTIONオブジェ...
-
VBScriptからDLL参照設定したい
-
python __del__()に関して
-
InternetExplorer.Application...
-
上下の位置揃えについて
-
UserForm1.Showでエラーになり...
-
エクセルのVBAの標準モジュール...
-
ActiveXコントロールを用いたマ...
-
AccessVBA NULLについて
-
VBで引数にDictionaryオブジェ...
-
Excel VBAでWordの複数ファイル...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
worksheetFunctionクラスのVloo...
-
「Columns("A:C")」の列文字を...
-
実行時エラー 3265「要求された...
-
エクセルのVBAの標準モジュール...
-
VBAで既に開いている別アプリケ...
-
VBAで Set wb = Sheets(1).Cop...
-
テキストボックス中の文字列の...
-
PowerPointVBAでスライドマスタ...
-
エクセルマクロエラー「'Cells'...
-
VBAからPDFファイルにパスワー...
-
Excelでフィルタをかけると警告...
-
オブジェクトが見つかりません
-
ある文字列が全て数字であるか...
-
EXCEL VBA オートシェイプナン...
-
[VBA]CDOメッセージ送信エラー
-
VBAで作成するメール(開封確認...
-
VBAについてです。 初心者です...
-
VBA:オートシェイプの線の長...
-
VBで引数にDictionaryオブジェ...
-
AccessVBAで「dim dbs as datab...
おすすめ情報