質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.99%

エクセルからマクロで文章のフォントを指定しパワーポイントのファイルを作成させたい

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 2,177

OMUSUBI

score 11

エクセルからパワーポイントを操作し、
エクセルに入力されている内容でパワーポイントを作成するマクロを作りたいと思っています。

エクセルのセルには文章、フォント種類、フォントサイズなどを事前に入力しています。実行すると文章を把握しデスクトップへパワーポイントに出力する様にしているのですが、フォント種類の変更やフォントサイズの変更がうまくいきませんでした。

コードは入力しているセル全てに変数を作り、
1行目の部分をまず何とかでないかという状態のコードになっています。2日間色々試して悩んでいますが初心者の為解決できませんでした。
コードはできていませんができれば座標もエクセルのセル入力で左端、上端からの距離で指定したいです。
仕事中はPCを確認できないため返答できるのが遅くなってしまいますが宜しくお願いします。

エクセルシート

    A B     C        D E
1         タイトル HGゴシックE            8
2         TEST1           HGゴシックE            8
3         TEST2           HGゴシックE            8

Sub パワーポイント作成()
Dim objPpt As Object  
Dim objFile As Object
Dim i As Long ’セル変更用

Dim Pword1 As String '挿入文章1を指定
Dim Fname1 As String ’文章1用フォント
Dim Fsize1 As Long ’文章1用フォントサイズ

Dim Pword2 As String ’挿入文章2を指定
Dim Fname2 As String ”文章2用フォント
Dim Fsize2   As Long ’文章2用フォントサイズ

Dim Pword3 As String
Dim Fname3 As String
Dim Fsize3   As Long

Pword1 = Cells(2+i,2)
Fname1 = Cells(2+i,2)
Fsize1 = Cells(2+i,2)
i  = i + 1
Pword2 = Cells(2+i,2)
Fname2 = Cells(2+i,2)
Fsize2 = Cells(2+i,2)
i + i + 1
Pword3 = Cells(2+i,2)
Fname3 = Cells(2+i,2)
Fsize3 = Cells(2+i,2)


strPPTFullPath = "C:¥Documents and settings¥user¥デスクトップ¥output .ppt"  'デスクトップを指定しています
Set objPpt = CreateObject("PowerPoint.Application")

objPpt.Visible = True

objPpt.Presentations.Add
Set objFile = objPpt.ActivePresentation

Set pslide1 = objFile.Slides.Add(1, 12)
with objPpt.Presentations(1).Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal _
        , 60, 60, 200, 50).TextFrame.TextRange.Text = Pword1
with objPpt.Presentations(1).Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal _
        , 60, 60, 200, 50).TextFrame.TextRange.font.NameFarEast = Fname1
End with


objPpt.Presentations(1).Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal _
        , 100, 100, 200, 50).TextFrame.TextRange.Text = Pword2

objPpt.Presentations(1).Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal _
        , 130, 130, 200, 50).TextFrame.TextRange.Text = Pword3

        
objFile.SaveAs strPPTFullPath
objFile.Close

objPpt.Quit

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

0

ご使用のWindows,Excel、PowerPointのバージョンが分かりませんし、自分の環境で試したところ何故か最初のテキストボックスだけフォントが正しく設定されないのですけれども…

以下の環境で確認しました。
> Windows 10
> Excel, PowerPoint 2016

動作の詳細を確認していませんが、OMUSUBIさんが作成されたVBAは以下の点が違っている、あるいは使い方があまり良くないと思います。
(細かいことを言えば他にもあるかもしれませんが、とりあえず下記2点を指摘させて頂きます。)
1. Cellオブジェクトは Cell(行番号列番号) → 目的のセルの内容が各変数に取り込めていない
2. With 〜 End With の使い方が不適切

それとひとつお願いですが、ソースコードを貼り付ける際は、通常の文章としてではなく </> というアイコンをクリックして、コード として貼り付けてください。(さもないと非常に読みにくいです。)

前提として、Excelのシートに以下のようにデータが入っているとします。
イメージ説明


Excelのシートから設定値を取り込む際には、配列 と For 〜 Next を利用してみました。そうすると、配列内には以下のように設定値が取り込まれます。
イメージ説明


VBAプログラムのコーディング例は下記のようになります。
Option Explicit

Sub パワーポイント作成()
  
  Dim objPpt As Object
  Dim objFile As Object
  Dim pslide1 As Object
  Dim strPPTFullPath As String
  
  Dim i As Long           '行番号
  Dim Pword(3) As String  '挿入文章(1,2,3)
  Dim Fname(3) As String  'フォント(1,2,3)
  Dim Fsize(3) As Long    'フォントサイズ(1,2,3)
  
  
  ' Excelシートから定義を配列へ読み込み
  With ThisWorkbook.Worksheets(1)
    For i = 1 To 3
      Pword(i) = .Cells(i, 3).Value   ' 行番号:i、列番号:3 (= C列)
      Fname(i) = .Cells(i, 4).Value   ' 行番号:i、列番号:4 (= D列)
      Fsize(i) = .Cells(i, 5).Value   ' 行番号:i、列番号:5 (= E列)
    Next i
  End With
  
  
  ' 出力先PowerPointのパスを設定(実際のパス、ファイル名はご使用の環境に合わせてください。)
  strPPTFullPath = "C:¥Documents and settings¥user¥デスクトップ¥output.ppt"
  
  
  Set objPpt = CreateObject("PowerPoint.Application")
  
  
  With objPpt
  
    ' 新規PowerPoint生成
    .Presentations.Add
    Set objFile = .ActivePresentation
  
    With objFile
      
      ' スライド追加
      Set pslide1 = .Slides.Add(1, 12)
      
      With pslide1.Shapes
        
        ' テキストボックス1追加
        With .AddTextbox(msoTextOrientationHorizontal, 60, 60, 200, 50)
          With .TextFrame.TextRange
            .Text = Pword(1)
            With .Font
              .Name = Fname(1)
              .Size = Fsize(1)
            End With
          End With
        End With
        
        ' テキストボックス2追加
        With .AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
          With .TextFrame.TextRange
            .Text = Pword(2)
            With .Font
              .Name = Fname(2)
              .Size = Fsize(2)
            End With
          End With
        End With
            
        ' テキストボックス3追加
        With .AddTextbox(msoTextOrientationHorizontal, 130, 130, 200, 50)
          With .TextFrame.TextRange
            .Text = Pword(3)
            With .Font
              .Name = Fname(3)
              .Size = Fsize(3)
            End With
          End With
        End With
        
      End With
      
      ' PowerPointを名前を付けて保存
      .SaveAs strPPTFullPath
      .Saved = True
      .Close
    End With
  
    ' PowerPoint終了
    .Quit
  End With
  
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2015/12/03 08:11

    コメント下さりありがとうございます。コメント頂けないと思っていたのでとてもありがたいです。教えていただいたコードは仕事から帰って試してみたいと思います。ありがとうございます。

    キャンセル

  • 2015/12/03 22:35

    pi-chanさん
    セルを設定し動作を確認すると無事動きました!
    ありがとうございます!
    With 〜 End Withの使い方や変数(3)の方法など素晴らしいと思いました。
    すぐに使いこなせないと思いますが参考にさせて頂きます。
    パワーポイントの事でまた相談させて頂くかもしれませんが宜しくお願いします。
    本当に助かりました。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.99%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる