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

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

新規登録して質問してみよう
ただいま回答率
85.51%

Q&A

解決済

1回答

3921閲覧

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

OMUSUBI

総合スコア14

0グッド

0クリップ

投稿2015/12/02 15:52

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

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

コードは入力しているセル全てに変数を作り、
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

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

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/02 21:28

pi-chan

総合スコア5936

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

OMUSUBI

2015/12/02 23:11

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

2015/12/03 13:35

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.51%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問