アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

A 回答 (4件)

こんばんは、


'--- テキストを取得 ---'
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で置き換えたいシェイプの種類を指定します)

ただし、掲示のコードを検証していませんので、見込みと違うエラーだった場合は、ごめんなさい。
    • good
    • 0
この回答へのお礼

早速ご回答ありがとうございます。
VBA初心者で申し訳ありません。
試してみます!

"置き換え前の文字"をパワポ内に見つけることが出来ないということでしょうか。
パワポ内に特定の文字を検索して、エクセルに入力された文字列を一つずつ置き換えていきたいのですが…
一つが置き換え出来ればfor〜nextで繰り返しの作業に編集すればできるのかな?と安易な考えです。

お礼日時:2021/04/25 08:49

こんばんは



エラーの内容の記述がないので推測になってしまいますが、すでに、No1様のご指摘にあるようにテキストを持っていないシェイプでエラーになっているものと想像しました。

HasTextプロパティで、テキストがあるかを調べられますので、あるものだけを処理の対象になさればよろしいのではないでしょうか。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

たとえば、以下でエラー回避をできませんか?
 If shapeObj.TextFrame.HasText Then
   ' *** 置き換えの処理
 End If
    • good
    • 1
この回答へのお礼

助かりました

早速ありがとうございます!
色々と方法があるのですね!
たしかめてみます!

お礼日時:2021/04/25 09:07

こんにちは


>置き換え前の文字"をパワポ内に見つけることが出来ないということでしょうか。そうです。
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で取得できます。

続く
    • good
    • 1

続き


For Each shapeObj In slideObj.Shapes
スライドオブジェクトのシェイプコレクションからループでシェイプを取得
これは、スライドやシートを取得する時と似ています。

しかし、コレクションからオブジェクトをFor Eachなどで取得すると
コレクション内すべてのオブジェクトが順に取得される為、
取得されるオブジェクトに種類や保護設定などがある場合を想定できる時は
.Type .Nameなどや該当プロパティを判定する 分岐処理が必要になります。
なぜエラーが出るかご理解いただけましたでしょうか。

対処方法
テキストを持つすべてのシェイプに対して処理を行いたいのであれば
(目的がテキストの置き換えなので)
#2様の方法が最も良いと思います。

On Error Resume Next 
これも行けるとは思いますが、デバッグ時、エラー特定の妨げになったり
内部的にエラーを黙認する事が気になります。

.HasTextが100点だとすると30点くらいの方法です。
私の場合、取り敢えずで使う事はあります。

シェイプの種類によって処理を分けたい場合は、
If shapeObj.Type = msoTextBox Then みたいに
シェイプのタイプを限定して実行するのも良いと思います。
(文字置き替えたくないシェイプなどを他のタイプで追加する事が出来ます)
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!