Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Excel 2016)
VBAからPowerpointのファイルを開くときにエラーが発生する。
投稿日時: 19/08/23 12:33:42
投稿者: dendentom

VBAからローカルフォルダに置かれているpowerpointのファイルが存在するかチェックし、
そのファイルを開くというコードを作っています。
プログラム中のもしファイルが特定のディレクトリに存在する場合のときの処理で「リモートサーバがないか、使用できる状態にありません。」というエラーが出てくるようになってしまいました。
以前はなかったのですが、最近よく出ます。
太字赤のところでエラーになります。どっちがエラーになるかはその時その時で変わってきます。
 
どんな理由があるのでしょうか?解決方法はあるのでしょうか?
 

You have to explicity declare all variables.
Option Explicit
'
'Declare public variable it available in this module
Dim pp_app As PowerPoint.Application
Dim pp_prs As Presentation


Function generate_weekly_report(ByVal wb_report As Workbook, ByVal web_app As String)

Set pp_app = New PowerPoint.Application
    
'################
'# Preparation
'################

    '# Set weekly report file path and name
    Dim report_file_name As String
        report_file_name = result_data_folder & "Weekly_Report_" & exe_date & ".pptx"

  [color=red][b]pp_app.Visible = True[/b][/color]
        
    If Dir(report_file_name) = "" Then
        '# When the weekly report file does not exist, open new weekly report and edit damy page of weekly report
        Set pp_prs = pp_app.Presentations.Open(default_weekly_report)
        '#Cover
        Call setting_shape(1, "Weekly Status Report" & vbLf & "Infra Tower", "NONE", "NONE", "NO")
        '#Page2
        Call setting_shape(2, "Hot/Import topics", "NONE", "NONE", "NO")
        '#Page13
        Call setting_shape(13, "Other Items", "NONE", "NONE", "NO")
    ElseIf Not Dir(report_file_name) = "" Then
        '# When the weekly report file exist, only open.
        [b]Set pp_prs = pp_app.Presentations.Open(report_file_name)[/b]
    End If
  
    '# Copy graph and table from each worksheet and charts of SNOW or Redmine.
    Select Case web_app

        Case "Redmine"
            '#Page3
            wb_report.Charts("BL1_chart_result").ChartArea.Copy
            Call setting_shape(3, "Redmine Backlog Reduction - Trends", "GRAPH", "BL1_graph", "YES")
        
            '#Page4 Table page
            Call setting_shape(4, "Redmine Backlog Reduction - Tickets to Handle", "NONE", "NONE", "NO")
                        
            '#Page5
            wb_report.Charts("WI1_chart_result_trkr").ChartArea.Copy
            Call setting_shape(5, "Workflow Improvement: Open Tickets Analysis - Tracker", "GRAPH", "JP1_graph_tracker", "YES")

            '#Page6
            wb_report.Charts("WI1_chart_result_ctgy").ChartArea.Copy
            Call setting_shape(6, "Workflow Improvement: Open Tickets Analysis - Category", "GRAPH", "JP1_graph_category", "YES")
 
            '#Page7
            Call setting_shape(7, "Workflow Improvement: Reduction of Open Tickets", "NONE", "NONE", "NO")
            
            '#Page8
            wb_report.Charts("WI2_chart_result").ChartArea.Copy
            Call setting_shape(8, "Workflow Improvement: Closed Tickets Analysis -Required Hours Trends", "GRAPH", "JP2_graph", "YES")

            '#Page9
            Call setting_shape(9, "Workflow Improvement: Reduction of Time Consumption", "NONE", "JP2_table", "NO")

            '#Page10
            Call setting_shape(10, "Calender", "NONE", "Calender", "YES")

        Case "SNOW"
            '#Page11
            wb_report.Charts("aggregate_graph").ChartArea.Copy
            Call setting_shape(11, "On Call Trend", "GRAPH", "OnCallTrend", "YES")
            '#Page12
            Call setting_shape(12, "On Call Trend", "NONE", "Category_table", "YES")
    End Select
    
    pp_prs.SaveAs report_file_name
    Set pp_prs = Nothing
    
    pp_app.Quit
    Set pp_app = Nothing
    
End Function

投稿日時: 19/08/23 12:37:15
投稿者: dendentom

申し訳ありません。
先ほど添付したーコードに太字赤が反映されていませんでした。
 
コード中の太字や色設定はできないみたいなので、こちらでエラーになる箇所を記載します。
・pp_app.Visible = True
  →21行目
・Set pp_prs = pp_app.Presentations.Open(report_file_name)
  →34行目
 

トピックに返信