dポイントプレゼントキャンペーン実施中!

今パワポに専用という文字があればaquarius0319に送るようにしています
これをexcelを対象にしたいのですがどこを変更すればよろしいでしょうか?

Sub 最終sample()
Const olMailItem = 0
Dim file As String
Dim pr As Presentation
Dim sl As Slide
Dim sh As Shape
Dim tb As Table
Dim r As Integer
Dim c As Integer
Dim s As String

Dim f1 As Boolean
Dim f2 As Boolean
Dim ol As Object
Dim mail As Object
Dim f As Object
Dim dic As Object
Dim k As Variant
Dim n As Variant
Dim mailTo As String

With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "ppt", "*.ppt?"
.InitialFileName = "C:\"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
file = .SelectedItems(1)
End With

Do
Set pr = Presentations.Open(file)
For Each sl In pr.Slides
f1 = False
f2 = False
For Each sh In sl.Shapes
If sh.HasTable Then
Set tb = sh.Table
For r = 1 To tb.Rows.Count
For c = 1 To tb.Rows(r).Cells.Count
s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
'宛先
If InStr(s, "専用") Then
f1 = True
mailTo = "aquarius0319"
End If
If InStr(s, "フレッツ") Then
f1 = True
mailTo = "b230420"
End If
If InStr(s, "INS") Then
f1 = True
mailTo = "b230420"
End If
If InStr(s, "秋田") And r < tb.Rows.Count Then
If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
End If
If f1 And f2 Then Exit Do
Next
Next
End If
Next
Next
MsgBox "無かった"
Loop Until True
pr.Close

If Not (f1 And f2) Then Exit Sub
'
MsgBox "見つけた"


Set ol = CreateObject("Outlook.Application")
Set mail = ol.CreateItem(olMailItem)
mail.Display

mail.To = mailTo '宛先
mail.Subject = "件名"
mail.Body = "本文"

'添付ファイル
mail.Attachments.Add file

'添付ファイル
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "添付ファイル", "*.*"
.InitialFileName = "C:\"
.AllowMultiSelect = True
If .Show Then
Dim o As Integer
For o = 1 To .SelectedItems.Count
mail.Attachments.Add .SelectedItems(o)
Next
End If
End With

'メール送信
mail.Send '送信

ol.Quit

End Sub

質問者からの補足コメント

  • >excelを対象にしたいのですがどこを変更すればよろしいでしょうか?
    エクセルの各セルを全部調べるという事でしょうか?

    回答
    そうです

    1)まずは、開く対象をpptでなくxlsxなどのエクセルファイルにします。

    回答 わかりました

    2)プレゼンテーション内の各スライドを調べているのと同様に、
     ブック内の各シートに対して文字を検索すれば宜しいかと。

    回答
    具体的にどこのコードを変えればいいか教えて貰ってもいいですか?

    No.1の回答に寄せられた補足コメントです。 補足日時:2021/11/03 14:58

A 回答 (1件)

こんにちは



>excelを対象にしたいのですがどこを変更すればよろしいでしょうか?
エクセルの各セルを全部調べるという事でしょうか?

1)まずは、開く対象をpptでなくxlsxなどのエクセルファイルにします。
2)プレゼンテーション内の各スライドを調べているのと同様に、
 ブック内の各シートに対して文字を検索すれば宜しいかと。
3)シート内の各セルを対象に文字列の有無を調べるのなら、
  Cells.Find
 で調べることができるでしょう。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

※ エクセルの場合、セル以外にもテキストボックスその他いろいろな文字を持ち得るオブジェクトがあるので、それらも全部調べるのであれば、上記とは別に調べる必要があります。
この回答への補足あり
    • good
    • 0

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