NotebookLM×Geminiで「自社の勝ちパターン」を完全再現！崩れない提案書を爆速生成するVBA実務ガイド

あなたはプロのコンサルタントです。
ソース：@自社の勝ちパターン集（NotebookLMのノートブック名） を参照して、
B社向けの新規提案書の構成案を作成してください。

**【重要】出力フォーマットの厳格なルール:**
後続のプログラムで処理するため、以下の形式（パイプ区切り）を厳守してください。
これ以外の余計な解説や前置きは一切不要です。表データのみを出力してください。

1. **1スライド = 1行** で出力すること。
2. **【絶対厳守】** セル内の改行は、実際の改行（Enter）を使わず、必ず文字列「<br>」に置き換えること。
3. Markdownの装飾（ボールド）は不要です。**箇条書きの行頭記号（・や-）も不要です。**（PowerPoint側で自動付与されるため）
4. 各行は必ず「|」で始まり、「|」で終わること。

**■ レイアウト番号の定義:**
あなたが構成案を作る際、スライドの用途に合わせて以下の番号を「2列目」に入れてください。
（※自社の正確な「レイアウト番号」は、後述する「手順②」のマクロで簡単に確認できます。まずはこのまま読み進めてください。）
* 表紙スライド = 1
* 目次/アジェンダ = 2
* 通常のコンテンツ（箇条書きなど） = 2
* 比較/2列コンテンツ = 4

**■ 各列の定義（5列構成）:**
1列目：スライド番号
2列目：レイアウト番号
3列目：スライドタイトル
4列目：本文（改行箇所には <br> を入れる）
5列目：画像/メモ指示

**■ 出力例:**
|1|1|DX推進のご提案|株式会社〇〇 御中|（空白）|
|2|2|現状の課題|社内ドキュメントが各所に散在し検索が困難<br>データ連携の遅れ|現場の作業風景画像|
|3|4|解決策の比較|A案：部分導入<br>B案：全面刷新|比較表のイメージ|

**出力をお願いします:**

Sub CheckLayoutIDs()

    ' 現在のスライドマスターに含まれるレイアウト名と番号を一覧表示します

    Dim i As Integer

    Dim msg As String

    Dim lay As CustomLayout

    

    msg = "【レイアウト番号一覧】" & vbCrLf

    For i = 1 To ActivePresentation.SlideMaster.CustomLayouts.Count

        Set lay = ActivePresentation.SlideMaster.CustomLayouts(i)

        msg = msg & i & ": " & lay.Name & vbCrLf

    Next i

    

    MsgBox msg, vbInformation, "この番号をGeminiに伝えてください"

    ' イミディエイトウィンドウにも出力

    Debug.Print msg

End Sub

Sub GenerateSlidesFromTable_v5()

    '-------------------------------------------------------

    ' NotebookLM/Geminiの出力からスライドを生成する（鉄壁版 v5.0）

    ' 機能1: 勝手な改行を自動結合

    ' 機能2: クリップボード取得失敗時の救済措置（ノート経由）

    ' 機能3: 改行コードの正規化（Mac/Unix対応）

    ' 必須：参照設定 Microsoft Forms 2.0 Object Library

    '-------------------------------------------------------

    Dim pptPres As Presentation

    Dim pptSlide As Slide

    Dim dataObj As New MSForms.DataObject

    Dim clipboardContent As String

    Dim rawLines() As String

    Dim mergedLines As Collection

    Dim currentLine As String

    Dim columns() As String

    Dim i As Long

    Dim layoutIndex As Integer

    Dim titleText As String

    Dim bodyText As String

    Dim noteText As String

    

    On Error GoTo ErrorHandler

    

    Set pptPres = ActivePresentation

    

    ' 0. スライドが1枚もない場合のケア（新規作成直後など）

    If pptPres.Slides.Count = 0 Then

        pptPres.Slides.AddSlide 1, pptPres.SlideMaster.CustomLayouts(1)

    End If

    

    ' 1. データ取得（クリップボード優先 → 失敗ならスライド1のノート）

    On Error Resume Next

    dataObj.GetFromClipboard

    clipboardContent = dataObj.GetText

    On Error GoTo ErrorHandler

    

    ' クリップボード失敗時の救済措置
If Trim(clipboardContent) = "" Or Len(clipboardContent) < 5 Then
Dim answer As Integer
Dim msgBoxText As String

' 文章を分けて結合（これならエラーになりません）
msgBoxText = "クリップボードからデータを取得できませんでした。" & vbCrLf
msgBoxText = msgBoxText & "【救済措置】" & vbCrLf
msgBoxText = msgBoxText & "スライド1枚目の「ノート欄」にGeminiの出力を貼り付けてありますか？" & vbCrLf
msgBoxText = msgBoxText & "「はい」を押すと、ノート欄から読み込みます。"

answer = MsgBox(msgBoxText, vbYesNo + vbQuestion, "データ取得エラー")

If answer = vbYes Then
If pptPres.Slides(1).HasNotesPage Then
clipboardContent = pptPres.Slides(1).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
End If
Else
Exit Sub
End If
End If

    If Trim(clipboardContent) = "" Then

        MsgBox "データが見つかりませんでした。", vbExclamation

        Exit Sub

    End If

    

    ' 2. 改行コードの正規化（Browserからのコピー対策）

    ' vbCr, vbLf をすべて vbCrLf に統一してから分割する

    clipboardContent = Replace(clipboardContent, vbCrLf, vbLf) '一旦Lfに統一

    clipboardContent = Replace(clipboardContent, vbCr, vbLf)   'CrもLfに統一

    clipboardContent = Replace(clipboardContent, vbLf, vbCrLf) '全てCrLfに戻す

    

    ' 3. 行データを整理（Geminiが勝手に入れた改行を結合する処理）

    rawLines = Split(clipboardContent, vbCrLf)

    Set mergedLines = New Collection

    

    Dim buffer As String

    buffer = ""

    

    For i = LBound(rawLines) To UBound(rawLines)

        Dim lineStr As String

        lineStr = Trim(rawLines(i))

        

        If lineStr <> "" Then

            ' 行頭が "|" で始まる場合は「新しいスライドの開始」

            If Left(lineStr, 1) = "|" Then

                If buffer <> "" Then mergedLines.Add buffer

                buffer = lineStr

            Else

                ' "|" で始まらない場合は、前の行の続きとみなして結合

                buffer = buffer & "<br>" & lineStr '改行コードの代わりに<br>で繋ぐ

            End If

        End If

    Next i

    If buffer <> "" Then mergedLines.Add buffer

    

    ' 4. 整理されたデータでスライド生成

    For i = 1 To mergedLines.Count

        currentLine = mergedLines(i)

        

        ' 先頭・末尾の|を削除

        If Left(currentLine, 1) = "|" Then currentLine = Mid(currentLine, 2)

        If Right(currentLine, 1) = "|" Then currentLine = Left(currentLine, Len(currentLine) - 1)

        

        columns = Split(currentLine, "|")

        

        ' 列数チェック（最低限 タイトル(2番目)まであれば生成試行）

        If UBound(columns) >= 2 Then

            

            ' A. レイアウト番号

            layoutIndex = Val(Trim(columns(1)))

            If layoutIndex <= 0 Or layoutIndex > pptPres.SlideMaster.CustomLayouts.Count Then layoutIndex = 2

            

            ' B. スライド追加

            Set pptSlide = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptPres.SlideMaster.CustomLayouts(layoutIndex))

            

            ' C. タイトル

            If pptSlide.Shapes.HasTitle Then

                pptSlide.Shapes.Title.TextFrame.TextRange.Text = Trim(columns(2))

            End If

            

            ' D. 本文

            If UBound(columns) >= 3 Then

                bodyText = columns(3)

                bodyText = Replace(bodyText, "<br>", vbCrLf)

                

                If pptSlide.Shapes.Placeholders.Count >= 2 Then

                    On Error Resume Next

                    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = bodyText

                    On Error GoTo ErrorHandler

                End If

            End If

            

            ' E. 画像指示

            If UBound(columns) >= 4 Then

                noteText = columns(4)

                If Trim(noteText) <> "" Then

                    If pptSlide.HasNotesPage Then

                        pptSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text = "【画像指示】" & vbCrLf & noteText

                    End If

                End If

            End If

        End If

    Next i

    

    MsgBox "スライド生成完了！" & vbCrLf & "生成枚数: " & pptPres.Slides.Count & "枚", vbInformation

    Exit Sub


ErrorHandler:

    MsgBox "エラーが発生しました。" & vbCrLf & "内容: " & Err.Description, vbCritical

End Sub