Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
PowerPointファイルが既に開かれているかを判定したい
投稿日時: 22/02/11 14:48:58
投稿者: Repo

先日質問させて頂いた者です。
ExcelVBAで指定フォルダ内の複数のPowerPointファイルを取得しその中から報告書Noを取得後、PDF変換して保存し、PowerPointファイルを最終版にする処理をしています。
 
本来はPowerPointの処理は非表示にしたいのですが、
最終版にするために以下のコードでPowerPointを表示状態で開きその後に最小化しています。

Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoTrue)

 
そしてPowerPointオブジェクトを閉じる処理も以下のように追加しています。
ppApp.Quit

 
 
上記条件だと
PDF変換しないPowerPointファイルを開いている状態で処理を行うと
最終的に全てのPowerPointファイルを最後に閉じてしまいます。
 
そのため
PDF変換するPowerPointは閉じる
PDF変換しないPowerPointは閉じない
 
というその分岐をしたいです。
 
PowerPointファイルが既に開かれているかを判定する内容を検索したらIs Nothingを使用する方法がいくつか紹介されていたので
 
※Aで分岐してフラグに設定するようにしようとしたら
どちらの条件(他のPowerPointが開いている/開いていない)でもTrueになってしまいます。
 
※Bでフラグを元にPowerPointアプリケーションを閉じるようにしたいと考えています。
 
処理の方法として考え方が良くないでしょうか?
よい方法があればアドバイスお願いいたします。
 
'**********************************************************************************************************
' Convert_PDF_PowerPoint
'  フォルダにあるPowerPointファイルから報告書Noを取得しPowerPointに変換
' 引数:McrPath, …自マクロファイルパス
' 引数:PP_PathName…変換元フォルダパス
' 引数:PP_FileName…変換するPowerPointファイル名 
' 引数:SaveFilePath…変換先フォルダパス
' 引数:FlgConvPP…PDF変換完了フラグ
'**********************************************************************************************************
Public Function Convert_PDF_PowerPoint(ByVal McrPath, PP_PathName ,PP_FileName ,SaveFilePath As String, ByRef FlgConvPP As Boolean) As String
    
    Dim ppApp As Object                             'PowerPoint.Application
    Dim ppPre As Object                             'PowerPoint.Presentation
    Dim ppSlide As Object                           'PowerPoint.Slide
    Dim ppShape As Object                           'PowerPoint.Shape
    Dim ppText As String                            'PowerPoint.Text
    Dim MustBreak As Boolean                        '報告書No取得フラグ
    Dim ppSMaster As Object                         'PowerPointSlideMater
    Dim ppSMasterLayout As Object                   'PowerPointSlideMaterCustomLayout
    Dim ppFile As Object                            'PowerPoint.File
  Dim FlgOpenCheck As Boolean                     '判定フラグ
  
    '初期設定
    ppText = ""
    Convert_PDF_PowerPoint = ""
   
    Application.ScreenUpdating = False
    
    Set ppApp = CreateObject("PowerPoint.Application")
 
  ※A
    If ppApp Is Nothing Then             'PowerPointが開かれていない場合

        FlgOpenCheck = False             'フラグをFalseにする

    Else                                 'PowerPointが開かれている場合
        FlgOpenCheck = True              'フラグをTrueにする

    End if

   
   'PowerPointを起動してスライド1ページ目の中の全てのShapeについてテキストがあればセルに出力する
   Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoTrue)
  
   'PowerPointを最小化する
   ppApp.ActiveWindow.WindowState = 2

   '全てのスライドに対して以下の処理を繰り返す
   For Each ppSlide In ppPre.slides
        
     '〜省略〜
       'パワーポイントファイル内から報告書Noを取得する
    
   Next

   'PDF形式でファイルを保存する
   With ppPre
   	.SaveAs FileName:=SaveFilePath, FileFormat:=32
   End With
    
   '最終版にする
   ppPre.Final = True
    
   'Presentationを閉じる
   ppPre.Close
   
  '変換対象以外のPowerPointが開かれていない場合
  If FlgOpenCheck = False Then				 '※B		
        ppApp.Quit	                                  'PowerPointを閉じる
   End If
 
   'PDF変換完了フラグをTrueにする
   FlgConvPP = True
 
    'オブジェクトの解放
    Set ppShape = Nothing
    Set ppSlide = Nothing
    Set ppPre = Nothing
    Set ppApp = Nothing
    
    Application.ScreenUpdating = True

End Function

回答
投稿日時: 22/02/11 23:12:46
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
※Aで分岐してフラグに設定するようにしようとしたら
どちらの条件(他のPowerPointが開いている/開いていない)でもTrueになってしまいます。

>If ppApp Is Nothing Then
他のPowerPointが開いている/開いていないをチェックしているわけではないので、
当然です。
  
ファイルが使われているかをチェックするには、
On Error Resume Next
Open filePath For Append As #fileNo
Close #fileNo
IF Err.Number >0 Then
   Msgbox "ファイルは使用されています。"
End If
これを試してみてください。
  
パワーポイントファイルでは、実行したことは無いが、
Excelファイルで実証済です。

回答
投稿日時: 22/02/12 16:04:36
投稿者: WinArrow
投稿者のウェブサイトに移動

追伸
 
↑コードを確認してみました。
PPTファイルを開いた状態で実行。
→Err.Number = 70
を確認しました。

投稿日時: 22/02/14 10:47:19
投稿者: Repo

WinArrow 様 コメントありがとうございます。
 
回答頂いた内容で質問があります。

引用:

ファイルが使われているかをチェックするには、
On Error Resume Next
Open filePath For Append As #fileNo
Close #fileNo
IF Err.Number >0 Then
   Msgbox "ファイルは使用されています。"
End If
これを試してみてください。

 
"filePath"はこれからPDF変換するPowerPointのファイルパスでよかったでしょうか?
 
また
Set ppApp = CreateObject("PowerPoint.Application")

このコードの下に上記のコードをいれてみましたが
 
Close #fileNo
の後に
Debug.Pring Err.Number
を入れて番号を確認したのですが、
他のPowerPointファイルを開かれていても、開いていない状態でも
Err.Numberが52と表示されました。
 
そのためIf文の分岐がうまくいきません。
 
方法がおかしいでしょうか?
お手数ですが、またご回答をお願いいたします。
[/code]

回答
投稿日時: 22/02/14 12:13:29
投稿者: WinArrow
投稿者のウェブサイトに移動

提示したコードをそのままコピペして実行したと思います。
 
ごめんなさい
参考オートを書くのを忘れました。
 
提示されたコードを、そのまま実行しても、エラーが出るのは当然です。
提示されたコードを理解することから始めましょう。
このエラーは、ファイル番号が間違っているからです。
ファイル番号を取得しましょう。
 
 
注意事項
(1)モジュールの先頭行に
Option Explicit
を記述するようにしてください。
そうすれば、実行時にコンパイルエラーになります。
※VBEの画面、「ツール」「オプション」「編集」タブ
「変数の宣言を強制する」にチェックを入れておけば、自動的に挿入されます。
(2)エラーの内容も確認しましょう
Debug.print Err.Description
 
(3)ファイル番号の取得
fileNo = FreeFile
 
 

回答
投稿日時: 22/02/14 12:39:10
投稿者: んなっと

こんな感じ。
 
  On Error Resume Next
  Set ppApp = GetObject(, "PowerPoint.Application")
  On Error GoTo 0
  If ppApp Is Nothing Then 'PowerPointが開かれていない場合
    FlgOpenCheck = False 'フラグをFalseにする
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
  Else 'PowerPointが開かれている場合
    FlgOpenCheck = True 'フラグをTrueにする
  End If

投稿日時: 22/02/14 15:20:25
投稿者: Repo

WinArrow様
 
コメント引き続きありがとうございます。
 

引用:

(1)モジュールの先頭行に
Option Explicit
を記述するようにしてください。
そうすれば、実行時にコンパイルエラーになります。

 
Option Explicitは宣言してしました。
教えて頂いたコードでデバッグエラーは特に落ちなかったです。。
 
Close #fileNo
の後に
Debug.Print Err.Number
Debug.Print Err.Description
をいれた結果は
"52"
"ファイル名または番号が不正です。"
と表示されました。
 
調べると、Openステートメントで開かれていないファイルの場合は52となるのですが(下記サイト)
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/bad-file-name-or-number-error-52
 
今の状態だと、Ifの分岐(※※)ではじめてOpenステートメントでPowerPointファイルを開くので
その前だと、他のPowerPointを開いていてもいなくても
Openステートメント使用していないので両方とも52となるのかなと思いました(考え方が甘いでしょうか)
 
On Error Resume Next
Open filePath(これから開くPowerPointファイルパス) For Append As #fileNo
Close #fileNo

IF Err.Number >0 Then             →Err.Number52
   Msgbox "ファイルは使用されています。"
Else
  'ファイルが開かれていないのでOpenステートメントでファイルを開く
  Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoTrue) '※※
End if

回答
投稿日時: 22/02/14 15:58:30
投稿者: Suzu

このプロシージャは 関数化 しています。
 
その上で、CreateObject を使い、新たな PowerPoint のプロセスを生成しており(ここが※Aの直前)
その後、ファイルを開いています。
 
ここで本来であれば、既に別プロセス、別ユーザーが そのファイルを開いているならば
読み取り専用 で開く事になりますから、Final プパパティーの変更は出来ないのでは?
 
よって、
 ファイルを開く前に 既に開いているかの確認、開いていれば 処理を中断する等の処理が必要です。
 

Sub Sumple()
Dim ppApp As PowerPoint.Application
Dim ppPre As PowerPoint.Presentation

Dim strFilePath As String
strFilePath = "C:\○○.ppt"

If fnkFileOpendCheck(strFilePath) = True Then
  Exit Sub
End If

Set ppApp = CreateObject("PowerPoint.Application")
Set ppPre = ppApp.Presentations.Open(Filename:=strFilePath, WithWindow:=msoFalse)
End Sub


Function fnkFileOpendCheck(FilePath As String) As Boolean
  Dim fileNo As Long

  fileNo = FreeFile()  ''これが抜けています
  On Error Resume Next
  Open FilePath For Append As #fileNo
  Close #fileNo
  If Err.Number <> 0 Then fnkFileOpendCheck = True
End Function

投稿日時: 22/02/14 16:03:03
投稿者: Repo

んなっと様
 
コメントありがとうございます。
教え頂いたコードを活用してみましたが、

On Error Resume Next
  Set ppApp = GetObject(, "PowerPoint.Application")
  On Error GoTo 0
  If ppApp Is Nothing Then        'PowerPointが開かれていない場合※A※

    FlgOpenCheck = False          'フラグをFalseにする
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
  
 Else                   'PowerPointが開かれている場合

    FlgOpenCheck = True          'フラグをTrueにする

  End If

 'PowerPointを起動する
   Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoTrue)
  
   'PowerPointを最小化する
   ppApp.ActiveWindow.WindowState = 2     ※B※

PowerPointファイルを開いていてもいなくても※A※ですべてElseの方の結果になりました。
Set ppApp = GetObject(, "PowerPoint.Application")

の後でErr.Numberをデバッグプリントしたのですが、どちらのパターンでも結果は"0"でした。
 
また※B※の部分でデバッグエラーになってしまいました。
実行時エラー'-2147188160(80048240)'
Application.ActiveWindow:無効な要求です。アクティブなドキュメントウィンドウがありません。」と表示されました。
If文の分岐で
Set ppApp = CreateObject("PowerPoint.Application")

を通らないのが原因かなと思っています。

回答
投稿日時: 22/02/14 16:05:49
投稿者: WinArrow
投稿者のウェブサイトに移動

e\Err.Number 52
は、ファイル番号が不正です。・・というエラーです
「fileNO」変数の定義していますか?
若し、変数定義されていなかったら、コンパイルエラーになるはずです。
デバッグエラーにはなりません。
結果はどうあれ、実行できているということは、
変数定義されているのかな?
 
そうすると、やはり、
「fileNO」に、適切な「値」がセットされていないからです。
 
以下、参考コードです。
 
 

Dim fileNo As Long

    fileNo = FreeFile
    On Error Resume Next
    Open PP_PathName For Append As #fileNo
    Close #fileNo

    If Err.Number > 0 Then
        '→Err.Number70
        MsgBox "ファイルは使用されています。"
        Exit Sub
    Else
        'ファイルが開かれていないのでOpenステートメントでファイルを開く
        Set ppPre = ppApp.Presentations.Open(Filename:=PP_PathName, WithWindow:=MsoTriState.msoTrue) '※※
    End If
    On Error GoTo 0

回答
投稿日時: 22/02/14 17:57:48
投稿者: WinArrow
投稿者のウェブサイトに移動

元のコード(※A部分)に対するコメント

引用:

Set ppApp = CreateObject("PowerPoint.Application")
  ※A
    If ppApp Is Nothing Then             'PowerPointが開かれていない場合
        FlgOpenCheck = False             'フラグをFalseにする
    Else              'PowerPointが開かれている場合
        FlgOpenCheck = True              'フラグをTrueにする
    End if

   
前レスにも書きましたが、
(1)IF条件の対象が、「ファイルではない」ということが、大きな間違いです。
(2)If条件の結果=Falseのとき、「プロシジャを抜ける」が抜けています。
 ファイルを開かいまま、次の処理が実行され、別のエラーが発生する。
   
そこで、
If条件の対象を「ファイルが使われている(開かれている)」関数(Suzuさんのレス)にすると
最初の思想が活きると思います。
但し、対象のファイルが使われている場合は、
> Set ppApp = CreateObject("PowerPoint.Application")
は、不要ですから、順序を逆にします。
 
    If chkFileUsed(FilePath:=PP_PathName) Then
        FlgOpenCheck = False
        Exit Function
    End If
    Set ppApp = CreateObject("PowerPoint.Application")
    Set ppPre = ppApp.Presentations.Open(Filename:=PP_PathName, WithWindow:=MsoTriState.msoTrue)
 
   以下省略
 
 
 
 
 
 
Private Function chkFileUsed(ByVal FilePath As String) As Boolean
Dim fileNO As Long
    chkFileUsed = False
    fileNO = FreeFile
    On Error Resume Next
    Open FilePath For Append As #fileNO
    Close #fileNO
    If Err.Number > 0 Then
        chkFileUsed = True
    End If
    On Error GoTo 0
         
End Function

回答
投稿日時: 22/02/14 19:14:47
投稿者: んなっと

最初の質問文を読むと、
 
PowerPointファイルが既に開かれているかを判定したい
 
ではなくて、
 
PowerPointアプリケーションが既に開かれているかを判定したい
(すでに実行中のPowerPointインスタンスが存在するかどうかを判定したい)
と読めるのですが。

回答
投稿日時: 22/02/14 21:31:45
投稿者: んなっと

こちらの環境では、
 
Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoFalse)
 
としたときに
ppApp.ActiveWindow.WindowState = 2 の行で  
 
実行時エラー'-2147188160(80048240)':
無効な要求です。アクティブなドキュメント ウィンドウがありません。 のエラーになります。
 
 
 
しかし、
 
Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoTrue)
 
であれば
ppApp.ActiveWindow.WindowState = 2 でエラーは発生しません。
 
環境に依存するのですね。

投稿日時: 22/02/15 11:49:18
投稿者: Repo

お世話になります。
色々コメント頂いたのに、時短勤務のため昨日返信ができず遅くなり大変申し訳ありません。
んなっと様のコメントを読み、
また皆様の昨日の返信を頂き修正しながら、少し疑問を抱いていたのですが
私も知識不足で質問し直さければいけないのにそのことに触れていないのは大変申し訳なかったのですが、
 
やりたいことは以下のファイルがあり、
 A.Excelマクロ
 B.PowerPointファイル(PDF変換するPowePointファイル [01フォルダ]に保存されている)
 C.全然関係のないPowerPointファイル(他の業務で編集中)
 
 C.のPowerPointを開いていた状態で
 A.のマクロを実行したときに
 B.のPowerPoitファイルを開きPDF変換して[02フォルダ]に保管する→BのPowerPointは最終版にして閉じる
 
という処理をしたときにBだけを閉じるはずがCも一緒に閉じてしまうので
 
んなっと様の説明通りPowerPointアプリケーションを閉じたくないという事をしたいです。

引用:
PowerPointアプリケーションが既に開かれているかを判定したい
(すでに実行中のPowerPointインスタンスが存在するかどうかを判定したい)

 
WinArrow様、Suzu様に教えて頂いたコードを実際に試してみたのですが結果として
Cのファイルを開いていても開かなくてもFalseになったのですが
このコードだとBのPowerPointファイルが使用されているというチェックの処理だと思うのですが
PowerPointアプリケーションが使用されているかのチェックをしたいと考えています。
私の説明不足や知識不足でいろいろ考えて頂いたのに大変申し訳ありません。
 
んなっと様
引用:

Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoFalse)
としたときに
ppApp.ActiveWindow.WindowState = 2 の行で  
実行時エラー'-2147188160(80048240)':
無効な要求です。アクティブなドキュメント ウィンドウがありません。 のエラーになります。

 
WithWindow:=MsoTriState.msoTrueにして行っていたつもりでしたが、謎ですが
記述ミスを直したらうまくいきました。ご迷惑をおかけしました。
 
しかしやはり
  Set ppApp = GetObject(, "PowerPoint.Application")
  On Error GoTo 0
  If ppApp Is Nothing Then        'PowerPointが開かれていない場合
    FlgOpenCheck = False          'フラグをFalseにする
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
 Else                   'PowerPointが開かれている場合
    FlgOpenCheck = True          'フラグをTrueにする
  End If

この結果はどちらにしても FlgOpenCheck = True になります。
On Error Resume Nextをなくして試してみたものの、
Set ppApp = GetObject(, "PowerPoint.Application")

の部分でエラーで落ちると思っていたのですがエラーにならずどうしたらいいのか悩んでいます。
If ppApp Is Nothing Thenの判定以外に何か方法はありますでしょうか?
 
私の知識、理解不足のため、皆さんにお時間とらせてしまい大変申し訳ありません。
色々コメント頂き助かっています。ありがとうございます。

回答
投稿日時: 22/02/15 14:30:31
投稿者: WinArrow
投稿者のウェブサイトに移動

事情、理解しました。
↓のような対応もあるかと思います。
 

    Set ppAPP = GetObject(, "PowerPoint.Application")
    If ppAPP.Presentations.Count > 0 Then
        MsgBox ppAPP.Presentations(ppAPP.Presentations.Count).Name
    End If

回答
投稿日時: 22/02/15 15:10:40
投稿者: Suzu

引用:
という処理をしたときにBだけを閉じるはずがCも一緒に閉じてしまうので
  
んなっと様の説明通りPowerPointアプリケーションを閉じたくないという事をしたいです。

 
?? なぜ、GetObject を使うのですか?
 
既に PowerPoint のアプリケーション(プレゼンテーションA )を開いていた場合
 PowerPoint.Application ---- プレゼンテーションA
    
 GetObject を使い、その アプリケーション のインスタンスを取得し、そこで プレゼンテーションBを開くと
 
 PowerPoint.Application ---+-- プレゼンテーションA
              |-- プレゼンテーションB
 
となります。
 
その GetObject にて、取得した アプリケーションを Quit したら、
プレゼンテーションA も閉じる事になりますよね。
 
 
初めから、別インスタンス として、新しい PowerPoint.Application を作成し
 
 PowerPoint.Application ----- プレゼンテーションA
 PowerPoint.Application ----- プレゼンテーションB
 
とすれば良いのでは?

回答
投稿日時: 22/02/15 16:00:32
投稿者: WinArrow
投稿者のウェブサイトに移動

Poweroint のインスタンスの不思議
 
    Set ppApp = CreateObject("PowerPoint.Application")
 
は、これで生成されるインスタンスなので、
既に、別インスタンスで実行している
"PowerPoint.Application"
は、関係ないと考えていたんですが、違うことが分かりました。
 
ケース1:既にファイルが開かれていない場合、
    Set ppApp = CreateObject("PowerPoint.Application")
    MsgBox ppApp.presentations.Count
で、「0」が表示されます。
 
ケース2:既にファイル(1う)が開かれている場合、
    Set ppApp = CreateObject("PowerPoint.Application")
    MsgBox ppApp.presentations.Count
で、「1」が表示されます。
 
従って、自分で開いたファイルも、自インスタンスに含まれてしまう
ということになります。
でも、GetObjectで既にファイルが開かれていることを把握しても、
自分で開いた以外のファイルが存在しているかをチェックするしかありません。
 

回答
投稿日時: 22/02/15 16:06:49
投稿者: WinArrow
投稿者のウェブサイトに移動

既に開いているファイルが存在するか確認するコードサンプル
 

Dim ppApp As Object, pptx As Long, Fcnt As Long
    Set ppApp = Nothing
    Set ppApp = CreateObject("PowerPoint.Application")
    Fcnt = ppApp.presentations.Count
    If Fcnt > 0 Then
        For pptx = 1 To Fcnt
            Debug.Print ppApp.presentations(pptx).Name
        Next
    End If
    Set ppApp = Nothing

回答
投稿日時: 22/02/15 16:21:26
投稿者: んなっと

この赤字部分も注目しなければなりませんね。
  If FlgOpenCheck = False Then            
        ppApp.Quit     'PowerPointを閉じる
   End If

回答
投稿日時: 22/02/15 16:24:38
投稿者: んなっと

なるほど、実行中のインスタンスの有無ではなく、
開いている他の「関係ないプレゼンテーションの数」を調べるのですね。
 
WinArrowさんの方法
 
    Fcnt = ppApp.Presentations.Count
    If Fcnt > 0 Then
    FlgOpenCheck = True
 
で代用できそうです。

回答
投稿日時: 22/02/15 16:27:37
投稿者: WinArrow
投稿者のウェブサイトに移動

↓の説明を見つけました。

引用:

一度に実行できる PowerPoint (Powerpnt.exe) インスタンスは1つだけです。 そのため、PowerPoint は Multiuse (単一インスタンス) サーバーです。

 
ですから、別インスタンスという考え方を捨てる必要があります。
インスタンス内に開かれてるファイルの中で、閉じてはいけないファイルがあるならば、
インスタンス,Quit
を回避することになるでしょう。

回答
投稿日時: 22/02/15 17:39:22
投稿者: Suzu

引用:
↓の説明を見つけました。
引用:
 
一度に実行できる PowerPoint (Powerpnt.exe) インスタンスは1つだけです。 そのため、PowerPoint は Multiuse (単一インスタンス) サーバーです。

 
あらま。
テストをしたのですが、、一緒に閉じている事に気づいていない。。
何のためのテストだか。。。 すいませんでした。
 
 
元々のコードを拝見する限り、関数化 をしているので
複数のファイルを操作する事も考慮しているのかと思われます。
 
最小化の処理も行われていますので、その辺りの状態も戻す必要があります。
であるなら、いっそのこと、
全部閉じて、既に開いていたファイルを開きなおし、ページ移動を行う という 選択肢もあるかと。
 
その場合は、関数内で インスタンスの有り無し を判定するのではなく
呼び出し元 で処理した方が良いですね。
 
-------------------------------------------------------------
それと、今更ではありますが。。
ExcelVBA PowerPointファイルを最終版(読み取り専用)に変更したい
https://www.moug.net/faq/viewtopic.php?t=81236
 
引用:
対象のファイルがファイルサーバー上での属性として「読み取り専用」にしているため、

これちらですが、読み取り専用に対し、Final 設定できますか?
属性変更ですから、上書き保存が必要と思います。
 
それとも、個々のファイルにではなく
フォルダに対して 他のユーザー の 書き込み権限を与えていない 状態なので
「読み取り専用」という表現なのでしょうか?
 
それなら、
・SetAttr ステートメント
・FSO の File オブジェクト Attributes
辺りで、ファイル毎の 属性変更が可能かと。

回答
投稿日時: 22/02/15 18:36:59
投稿者: WinArrow
投稿者のウェブサイトに移動

final = True
が「読み取り専用」にするだけのことでしたら、
わざわざPowerPontファイルを開kずとも、
Attrプロパティをセットするだけで済みますね・・・・
圧倒的に楽、早い、確実。・・・と思います。

回答
投稿日時: 22/02/15 18:48:22
投稿者: んなっと

よく読まないと見当違いの方向に行ってしまいそうですね。

引用:
やりたいことは以下のファイルがあり、
 A.Excelマクロ
 B.PowerPointファイル(PDF変換するPowePointファイル [01フォルダ]に保存されている)
C.全然関係のないPowerPointファイル(他の業務で編集中)
  
 C.のPowerPointを開いていた状態
 A.のマクロを実行したときに
 B.のPowerPoitファイルを開きPDF変換して[02フォルダ]に保管する→BのPowerPointは最終版にして閉じる

回答
投稿日時: 22/02/15 18:51:33
投稿者: んなっと

そんなわけで、WinArrowさんの方法でいいと思います。
 
    Fcnt = ppApp.presentations.Count
    If Fcnt > 0 Then
 
これ以外は余計な書き込みになるような気がします。

回答
投稿日時: 22/02/15 20:11:38
投稿者: WinArrow
投稿者のウェブサイトに移動

読取り専用にセットする超簡単なコード
 
    Call SetAttr(PathName:=sFilePath, Attributes:=vbReadOnly)

回答
投稿日時: 22/02/15 23:57:39
投稿者: WinArrow
投稿者のウェブサイトに移動

追加情報
 
Final = True

エクスプローラのプロパティの「読み取り専用」
とは、別物みたい。
 

回答
投稿日時: 22/02/16 08:40:32
投稿者: WinArrow
投稿者のウェブサイトに移動

追加情報2
 
PPT.Final = True
は、内部的にすべてに編集機能を制限する機能らしいです。(最終版)
(リボンが表示されません)
読み取り専用にすると謳われているが、
エクスプローラのファイルのプロパテイにある「読み取り専用」には、チェックは入りません。
 
「読み取り専用にする」という言葉だけで、ファイルのプロパテイにある「読み取り専用」と誤解してしまいました。
Excel,Wordにもこの機能は存在します。
最終場に設定すると、リボン表示の場所に「編集」ボタンが表示されます。
「編集」をクリックすると、最終版が解除されて、編集可能になります。
勿論、上書き保存可能です。
 
私見ですが、目的次第では、効果があるかもしれません。
 
今回は、いろいろ、勉強になることがありました。
この場をお借りして、御礼申し上げます。
 
 
 
 
 

回答
投稿日時: 22/02/16 08:50:24
投稿者: Suzu

引用:
Final = True

エクスプローラのプロパティの「読み取り専用」
とは、別物みたい。

 
私もついでに、、
ファイル プロパティー の 詳細内 の
 コンテンツ 内容の状態 に 【最終版】が表記されます
 これを削除しても PowerPoin で開いた時には、Final状態になっています。
 
  よって、Final = True にした時に、【最終版】と書き込まれるだけの様なので
  ファイルプロパティの値を書き換えても Final の 属性は変わらない様です。

回答
投稿日時: 22/02/16 09:23:18
投稿者: んなっと

Suzuさんに質問させてください。

引用:
?? なぜ、GetObject を使うのですか?
  
既に PowerPoint のアプリケーション(プレゼンテーションA )を開いていた場合
 PowerPoint.Application ---- プレゼンテーションA
     
 GetObject を使い、その アプリケーション のインスタンスを取得し、そこで プレゼンテーションBを開くと
  
 PowerPoint.Application ---+-- プレゼンテーションA
              |-- プレゼンテーションB
  
となります。
  
その GetObject にて、取得した アプリケーションを Quit したら、
プレゼンテーションA も閉じる事になりますよね。

この書き込みの意図は何でしょうか?

回答
投稿日時: 22/02/16 12:03:32
投稿者: WinArrow
投稿者のウェブサイトに移動

質問者さんへ・・・・ちょっとした疑問
  
今回のプロシジャの内容を拝見すると
(1)PPT内の特定データを取得し、Excelに転記
(2)PPT→PDF
(3)PPTの最終版を別フォルダに複写
というような機能があるような感じを受けます。
  
  
(2)PDF出力に際して
PPTは、プレゼン効果として「アニメーション)」があります。
PDF出力すると、スライド毎に最後のアニメ―ション図が印刷されます。
要するに、図が重なっていれば、「後ろに隠れた図は見えなくなる」ということです。
アニメーションは、使われているのでしょうか?
印刷機能の中には、1ページに複数スライドを印刷する機能があります。
名前を付けて保存でPDF出力するとこの機能は使えません。
「印刷」でPDF出力は検討する価値はないのでしょうか??
  
(3)最終版異能について
最終版に設定してもスライドショーは可能です。
最終版のどの程度、期待しているかわかりませんが、
スライド形式で保存することも可能です。
スライド形式のファイルは更新できません。

回答
投稿日時: 22/02/16 13:54:30
投稿者: Suzu

んなっと さんへ

んなっと さんの引用:
この書き込みの意図は何でしょうか?

 
初めは CreateObject で、新規インスタンスを作成するフローだったのですが
途中で、GetObject にて 既存インスタンスの参照 を行う様なコードになっていました。
 
既存インスタンス では、プレゼンテーションが開いているにも関わらず Quit を行えば
既に開いているプレゼンテーションファイルも閉じる事になるので
 
既に PowerPoint のプレゼンテーションが 開いているかどうかに関わらず
別インスタンスを作成し、そのインスタンス内で PDF化、Filalプロパティ の変更を行えば
開いているプレゼンテーションを閉じる事もないだろう
 
と言う意図です。
 
既にプレゼンテーションを開いている状態で、
CreateObjectにて、PowerPoin Application インスタンスを作成し
別 プレゼンテーションを開き 閉じる事を確認し発言したのですが、
Quit した際に、開いていたプレゼンテーション が閉じている事に気づかず
そのまま発言していました。

投稿日時: 22/02/16 14:19:45
投稿者: Repo

お世話になります。
前日引き続きたくさんのアドバイスをありがとうございます。
すごく色々考えて頂き本当にありがとうございます。
勤務上すぐに返信できることができず申し訳ありません。
 
頂いたコメントを元に下記のコードで進めていきたいと思っていますが不明点があるので
一応参考の意見を聞かせて頂きたいと思います。
 

Dim ppApp As Object, pptx As Long, Fcnt As Long
    Set ppApp = Nothing
    Set ppApp = CreateObject("PowerPoint.Application")
    Fcnt = ppApp.presentations.Count '※A
    If Fcnt > 0 Then
        For pptx = 1 To Fcnt
            Debug.Print ppApp.presentations(pptx).Name
        Next
    End If
    Set ppApp = Nothing

上記のコードで
私のパソコンでCのPowerPointファイルを開いた状態でマクロ実行すると
1つしかPowerPointファイルが開いていないのですが、Fcnt(※A)の値が'2'と返ってきます。
しかし他の方や他の端末でマクロを実行したところ'1'と値が返って正常な処理ができました。
 
私のパソコンが以前テストした時の取得したPowerPointオブジェクトがデバッグエラーで中断したために解放されていない?残っている?のと思い(パソコン上ではPowerPointは開いていない)、パソコンを再起動をし直してもう一度テストしたのですがやはり"2"と値が返ってきます。
なにか原因がありますでしょうか?
 
WinArrow様
引用:

今回のプロシジャの内容を拝見すると
(1)PPT内の特定データを取得し、Excelに転記
(2)PPT→PDF
(3)PPTの最終版を別フォルダに複写

 
(3)については01フォルダのPowerPointファイルをそのまま最終版にします。(別フォルダに複写ではなくPowerPointファイル自体を最終版に変更します。)
引用:

(2)PDF出力に際して
PPTは、プレゼン効果として「アニメーション)」があります。
PDF出力すると、スライド毎に最後のアニメ―ション図が印刷されます。
要するに、図が重なっていれば、「後ろに隠れた図は見えなくなる」ということです。
アニメーションは、使われているのでしょうか?
印刷機能の中には、1ページに複数スライドを印刷する機能があります。
名前を付けて保存でPDF出力するとこの機能は使えません。
「印刷」でPDF出力は検討する価値はないのでしょうか??

 
こちらの方は指示者に確認をしたのですが、アニメーションは使わないため検討はしないとの事でした。
ご指摘頂きありがとうございます。
 
WinArrow様 Suzu様
最終版についてですが、
引用:
こちらですが、読み取り専用に対し、Final 設定できますか?
属性変更ですから、上書き保存が必要と思います。
  
それとも、個々のファイルにではなく
フォルダに対して 他のユーザー の 書き込み権限を与えていない 状態なので
「読み取り専用」という表現なのでしょうか?

 
すみません、以前の私の書き方がよくなく混乱させてしまい申し訳ありまえん。
指摘頂いてから、指示者にこちらのサイトを見てもらい確認したのですが
ExcelやPowerPointに読み取りパスワードを設定したファイルを最終版にすることはあるのですが、サーバー上で属性「読み取り専用」に設定したファイルをマクロで処理するケースはないとの回答でした。
以下のページの様に設定したPowerPointファイルをPDF変換するとの事でした。
https://recoverit.wondershare.jp/file/how-to-set-or-cancel-powerpoint-read-only.html?utm_source=yahoo&utm_medium=cpc&utm_campaign=recoveritDSA&yclid=YSS.1000318489.EAIaIQobChMIhPjS4LmD9gIVhiRgCh1r6Q6oEAAYASAAEgLMf_D_BwE
 
引用:
(3)最終版異能について
最終版に設定してもスライドショーは可能です。
最終版のどの程度、期待しているかわかりませんが、
スライド形式で保存することも可能です。
スライド形式のファイルは更新できません

 
マクロの処理として、
引用:
(1)PPT内の特定データを取得し、Excelに転記
(2)PPT→PDF
(3)PPTの最終版を別フォルダに複写

 
この後に(2)のPDFファイルと(3)のPowerPointファイルをそれぞれ違うメール文に添付して送信する処理をしています。
最終版にしたいのは、添付したファイルを編集されたくないのが目的みたいで
一時期は読み取り専用のPowerPointファイルを添付する方法も行っていましたが
指示者の目的とは異なるみたいなので最終版にする処理にしています。
 
色々お騒がせしていまい申し訳ありません。
宜しくお願いいたします。

回答
投稿日時: 22/02/16 14:42:55
投稿者: んなっと

Suzuさん、
 
  If FlgOpenCheck = False Then
        ppApp.Quit 'PowerPointを閉じる
   End If
 
となっていますので、FlgOpenCheckがFalseのときのみ
PowerPointアプリケーションを閉じているのです。
 
この重要な部分を見落とさないでほしかった。

回答
投稿日時: 22/02/16 16:24:49
投稿者: Suzu

引用:
私のパソコンでCのPowerPointファイルを開いた状態でマクロ実行すると
1つしかPowerPointファイルが開いていないのですが、Fcnt(※A)の値が'2'と返ってきます。
しかし他の方や他の端末でマクロを実行したところ'1'と値が返って正常な処理ができました。

 
プレゼンテーションファイル の数には、非表示となっているファイルも含まれます。
2 と 表示される PowerPoin では、
 アドインファイルも開いているものと思われます。
 「開発」タブ にて、PowerPoinアドイン に 読み込み済み のファイルがないか
  VBE のプロジェクト一覧 に、複数のファイルがないか
  のどちらかで確認できると思います。
 
 (Excel の場合だと、個人マクロのPersonal ファイル が非表示で開かれると共に、
    アドインも開かれます)
 
ですので、ファイル名の拡張子 ppa、ppam のファイル以外 の数を数える様にしてください。
 
---------------------------------------------------------------------------------
 
「Final」 の 目的 が、読み取り専用 と警告するだけですよね。
  ファイルの編集を 防ぐ事はできません。「編集する」を押せば編集はできる状態になります。
 
 1クッション を置けば 編集可能な状態のファイル と言う意味では
  エクスプローラーからファイル右クリックの 「読み取り専用」属性と変わらないと思っています。
 
【添付したファイルを編集されたくないのが目的みたいで】なのであれば、
PowerPoin の ファイル - 情報 プレゼンテーションの保護 パスワードを使用して暗号化
  書き込みパスワード の設定がある事も理解されていて Final にこだわっていらっしゃるので
質問者 さん側にて、お決めになる事なのでこれ以上は申しません。
 
---------------------------------------------------------------------------------
 
 
んなっと さん
引用:
この重要な部分を見落とさないでほしかった。

そうですね。 失礼しました。

回答
投稿日時: 22/02/16 16:56:17
投稿者: WinArrow
投稿者のウェブサイトに移動

追加情報3
 
>PPTファイルをメールで送る
とありますが、
エクスプローラの「読み取り専用」にチェックを入れたファイルを添付ファイルでメール送信
したところ、受信時にチェックが外れていました。
参考にしてください。
 

投稿日時: 22/02/17 11:51:37
投稿者: Repo

お世話になります。コメントありがとうございます。
 
WinArrow様

引用:

追加情報3
>PPTファイルをメールで送る
とありますが、
エクスプローラの「読み取り専用」にチェックを入れたファイルを添付ファイルでメール送信
したところ、受信時にチェックが外れていました。
参考にしてください。

 
この点については、以前指示者(上司)が検証していて理解していました。
引き続き参考にさせて頂きます。ありがとうございます。
 
Suzu様
引用:

プレゼンテーションファイル の数には、非表示となっているファイルも含まれます。
2 と 表示される PowerPoin では、 アドインファイルも開いているものと思われます。
 「開発」タブ にて、PowerPoinアドイン に 読み込み済み のファイルがないか
  VBE のプロジェクト一覧 に、複数のファイルがないか
  のどちらかで確認できると思います。
  (Excel の場合だと、個人マクロのPersonal ファイル が非表示で開かれると共に、
    アドインも開かれます)
ですので、ファイル名の拡張子 ppa、ppam のファイル以外 の数を数える様にしてください。

 
こちらについて、これはマクロファイルの「開発」タブの事でいいでしょうか?
現状「開発」タブのアドインを確認すると
「アドイン」「Excelアドイン」「COMアドイン」と3つありますが
どのように確認すればいいのかを教えて頂けると助かります。
「アドイン」を選択したら「Officeアドインがありません」と表示されていました。
ネットでアドインについて確認したのですがどのようにすればいいのかが理解できませんでした。
VBEプロジェクト一覧には複数のファイルはありませんでした。
 
またファイル名の拡張子については、ppAppに対してのファイル名の拡張子の取得方法が理解できず調べるとGGetFileNameなどがありますが、違うような気もしまして、そちらも教えて頂けると助かります。
理解不足で大変申し訳ありません。
 
またマクロファイル自体がおかしいのではないかと思い、
新規のブックに必要なシート、Moduleをコピーして、参照設定をして
マクロファイルと同じファイルに構成したのですが
実行するとやはりカウント数が'2'となりました。
ローカルウィンドウでppApp.PresentationをCountを確認したら'2'と表示されました。

回答
投稿日時: 22/02/17 13:07:01
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

実行するとやはりカウント数が'2'となりました。
ローカルウィンドウでppApp.PresentationをCountを確認したら'2'と表示されました。

 
探し方が理解できていないようですね・
 
↓のコードで確認してみましょう
Dim PPTX As Long
Set ppApp = CreateObject("PowerPoint.Application")
With ppApp
    For PPTX = 1 To .Presentations.Count
        Debug.Print .Presentations(PPTX).Name
    Next
End With

回答
投稿日時: 22/02/17 14:28:57
投稿者: Suzu

私のパソコンでCのPowerPointファイルを開いた状態でマクロ実行すると
1つしかPowerPointファイルが開いていないのですが、Fcnt(※A)の値が'2'と返ってきます。
しかし他の方や他の端末でマクロを実行したところ'1'と値が返って正常な処理ができました。

 
当方でも 再現できるマシンがありました。
 
 
結論から言うと、Presentations.Count では 判定不足。
 
参照前 の 初期化済み とおぼしき オブジェクトが
Presentetions コレクションに 存在し その数も含めて カウントされています。
 
おかしい挙動をする マシンにおいて、以下の コードで確認できます。
 
Sub TEST()
  Dim ppApp As PowerPoint.Application

  Dim Fcnt As Long
  Dim pptx As Long
  Dim strMsg As String

  On Error Resume Next
  Set ppApp = GetObject(, "PowerPoint.Application")
  If Err.Number <> 0 Then
    Set ppApp = CreateObject("PowerPoint.Application")
  End If
  On Error GoTo 0

  ppApp.Visible = True

  Fcnt = ppApp.Presentations.Count
  Debug.Print "TEST : プレゼンテーション数" & Fcnt   '※A

  If Fcnt > 0 Then
    On Error Resume Next
    For pptx = 1 To Fcnt
      strMsg = vbTab & "プレゼンテーション" & pptx
      strMsg = strMsg & vbTab & ppApp.Presentations(pptx).Name
      Debug.Print strMsg
    Next
    On Error GoTo 0
  End If

  ppApp.Quit
  Set ppApp = Nothing
End Sub

 
結果
----------------------------------
TEST : プレゼンテーション数2
  プレゼンテーション1
  プレゼンテーション2 hogehoge.pptx
----------------------------------
イミディエイトウィンドに Count数と そのコレクションのアイテム名が表示されます。
 
 
 
確認用のコードを 良かれと思って提示していますが
正確な確認としては、
 
1. コードをシングルステップにて実行
2. 必要なオブジェクトの中身が確認できるステップでの
  オブジェクト変数の中身を VBE のローカルウィンドにて確認します。
  今回であれば、※A の位置で良いでしょう。
 
そこでは、
引用:
Application : <Presentation.Application : 無効な要求です。自動化の権限がありません。> : Application

 
の様になっており、参照されていないオブジェクトが入っていて Count数が +1 されている事が判ります。
 
 
なので、
Presentations コレクション の中身 を、
提示したコードの様に、エラートラップ を行い ひとつづつ 参照し
参照できたか の結果 をふまえた 判定が必要となると思います。
 
これが、何故おこるのか。。
ちょと判りません。
COMアドイン の 使用できるアドイン の一覧に、
 読み込まれていない アドイン として、1ファイルあり、それなのか。。
 削除しても、 Count数は、+1 のまま
 (Windows を 再起動すれば直るのかもしれませんが そこまでは確認していません)
 
 
============================================================
今回とは、直接関係ありませんが
Word と同じように、 Application.Quit を 行っても、プロセスは消えないのですね・・
 
非表示になるタイミングも
Set ppAppp = Nothing のタイミングであったり、消えない事も・・・
Excel と同じ感覚で オートメーションで操作するには ちょっとクセが強い。。
 
 
安定動作の為には、Excelから操作するのではなく、
PowerPoint 側の VBAで、Final と PDF化 を行い
同時に、PowerPoin側から Excel へ書き込み の方が安定かもです。

投稿日時: 22/02/18 13:03:10
投稿者: Repo

お世話になります。コメントありがとうございます。
 
Suzu様
やはり同じような現象が起こるのですね。
自分のパソコンがおかしいのかと思いましたが納得できました。
一応あれから再起動をしたのですが、やはりFCntは'2'と表示されました。
 
コメントを指示者と確認して相談したのですが、
結論としては、現状のままだと
 
@CのPowerPointファイルを開いた状態でマクロ実行をしたときは、PDF変換したPowerPointファイルは閉じて、CのPowerPointファイルは閉じられない。
 
APowerPointファイルを開いていない状態でマクロ実行をしたときは、PDF変換したPowerPointファイルは閉じるが、PowerPointアプリケーションは残る状態
 
このような状態でありますが、
こちら側としては、@で編集中のPowerPointファイルを閉じられてしまうのが困るので(修正した今のコードだと問題はない)
AのようにPowerPointアプリケーションが残るが、その場合はユーザーが手動で閉じるようなルールにする
という形になりました。
 
本来ならばPowerPointVBA側での操作を考えましたが、マクロ自体も部署内でリリースしており使用しているので修正する工数を考えると一応このままで進めていきます。
 
 
WinArrow様

Dim PPTX As Long
Set ppApp = CreateObject("PowerPoint.Application")
With ppApp
    For PPTX = 1 To .Presentations.Count
        Debug.Print .Presentations(PPTX).Name
    Next
End With

教えて頂きありがとうございました。
結果はCountは2になり、Debug.Print .Presentations(PPTX).Nameでデバッグエラーになりましたが、Suzu様の言われていた[参照前の初期化済み とおぼしき オブジェクト]が原因かなと思います。
 
最終版・読み取り専用についても色々調べて頂き参考になりました。
指示者とコメントを見直して改めて今の方法について再確認できてよい機会でした。
 
んなっと様
私の説明不足について色々フォローのコメント頂きありがとうございました。
質問の書き方について今度は相手に分かるような書き方をしたいと思います。
 
皆様本当にお時間頂いてコメント頂きありがとうございました。
また質問する際には宜しくお願いいたします。