VBAマクロでExcelからWordやPowerPointに値を貼り付ける その４：すでにあるシェイプに値を流し込む

shuzo-kino.hateblo.jp
の続き

一歩進んで、すでにレイアウトされているシェイプに流し込む方法を検討。

実際のところ

こんな感じのシートを用意します。
オレンジを最初に、次に緑を生成しました。

Excelシートから結果を取得、すでに用意してある方法に流し込みます。

Sub Test()
    
    '変数の定義
    Dim excelFilePath As String
    Dim sheetName As String
    Dim rngCopy As String
    Dim dstSlide As Long
    Dim excelstr As String
    
    
    excelFilePath = "C:\Users\user\Desktop\Book1.xlsm"
    sheetName = "Sheet3"
    rngCopy = "A3"
    dstSlide = 1
    
    'Excelシートから値を確保する
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation
 
    'セルをコピー
    excelstr = wb.Sheets(sheetName).Range(rngCopy)
    
    'PPTの指定スライドに張り付ける
    ppt.Slides(dstSlide).Shapes(1).TextFrame _
        .TextRange.Text = excelstr

    
    'Excelをとじる
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
End Sub

結果はこんな感じに。１始まりみたいです。

実験してみたところ、追加された順番に番号が振られれる様子。
途中で消したり入れ替えるとまた違うかもしれませんが……。

参考もと

エクセルVBAでPowerPointのテキストボックスに文字を入力する

Shape.TextFrame プロパティ (PowerPoint) | Microsoft Docs

VBAマクロでExcelからWordやPowerPointに値を貼り付ける その３：テキストフレームに要素を反映する

shuzo-kino.hateblo.jp
の続き

多分、ほとんどの人にとっては本命のネタ。
Excelシートから内容ひっぱりだして、スライド内にテキストエリアとして貼り付ける方法について。

実際のところ

PPTにテキストフレームを追加する

まずはExcelは無しで単純にマクロ越しにテキストフレームを追加してみます

Sub Test()
Set myDocument = ActivePresentation.Slides(1)

With myDocument.Shapes _
        .AddShape(msoShapeRectangle, 180, 175, 350, 140).TextFrame
    .TextRange.Text = "Here is some test text"
    .MarginTop = 10
End With
End Sub

実行すると、青い四角が出てきます。
イマドキのＰＰＴはデフォが色付きだからですかね。

Excelからデータを引っ張りだして、テキストフレームに流し込む

では本題。
先ほどの結果を踏まえて、Excelシートから結果を取得、流し込みます。

Sub Test()
    
    '変数の定義
    Dim excelFilePath As String
    Dim sheetName As String
    Dim rngCopy As String
    Dim dstSlide As Long
    Dim excelstr As String
    
    
    excelFilePath = "C:\Users\user\Desktop\Book1.xlsm"
    sheetName = "Sheet3"
    rngCopy = "A3"
    dstSlide = 1
    
    'Excelシートから値を確保する
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation
 
    'セルをコピー
    excelstr = wb.Sheets(sheetName).Range(rngCopy)
    
    'PPTの指定スライドに張り付ける
    ppt.Slides(dstSlide).Shapes.AddShape(msoShapeRectangle, 180, 175, 350, 140).TextFrame _
        .TextRange.Text = excelstr

    
    'Excelをとじる
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
End Sub

すでにあるシェイプに値を流し込む場合は、シェイプの通し番号を指定して値を流し込む様子。
これは次回やります。

参考もと

Shape.TextFrame プロパティ (PowerPoint) | Microsoft Docs

VBAマクロでExcelからWordやPowerPointに値を張り付ける その２：テーブルとして貼り付ける

実際のところ

パワポ側で実行するマクロです。
デフォだとExecelのオブジェクトを読みださないので、「ツール」=>「詳細設定」をひらき、Excelオブジェクト読み出しを有効にします。

これがないと、「ユーザー定義マクロが定義されていません」てなエラーを吐いて先に進めません。

マクロ本体

写経元では関数とDIMに分かれてましたが、理解のためバラしました。
その過程でエラー処理も殴り捨てた侠気仕様。

Sub Test()
    '変数の定義
    Dim excelFilePath As String
    Dim sheetName As String
    Dim rngCopy As String
    Dim dstSlide As Long
    
    excelFilePath = "C:\Users\user\Desktop\Book1.xlsm"
    sheetName = "Sheet3"
    rngCopy = "A1:B4"
    dstSlide = 1
    
    'Excelシートから値を確保する
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation
 
    'セルをコピー
    wb.Sheets(sheetName).Range(rngCopy).Copy
    
    'PPTの指定スライドに張り付ける
    ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
    
    'Excelをとじる
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'PPTの表を位置揃え
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
            .Left = shapeLeft
            .Top = shapeTop
        End With
    End If
End Sub

結果

真っ新なPPTファイルならタイトル入力のアレになってると思います。
これに、指定範囲のExcelファイルから作られたテーブルが追加されます。

参考もと

VBA Paste from Excel to PowerPoint - Copy Paste Excel to PowerPoint
VBAで表やグラフをPowerPointへ貼り付ける｜VBAサンプル集

VBAマクロでExcelからWordやPowerPointに値を張り付ける その１：どういう機能なのか

Youtubeを徘徊していたら、こんな動画を発見
www.youtube.com

VBAマクロってExcelだけだと思ったのですが……PowerPointとも連動できるんですね……！？

実際のところ

公式を見に行くと……以下のような感じで公式が煽ってきます（白目

Word で 50 個の表を繰り返しクリーンアップしていませんか。 特定の文書が開かれたときに、ユーザーに入力を求めるようにする必要はありませんか。 Microsoft Outlook の連絡先を Microsoft Excel のスプレッドシートに効率よく転記する方法を求めてはいませんか。

Visual Basic for Applications (VBA) for Office を使用すると、これらの作業を実行し、さらにそれ以上のことを実現できます。VBA for Office は、単純でありながら強力なプログラミング言語であり、Office アプリケーションを拡張するために使用できます。

参考もと

docs.microsoft.com

【蛇足】プログラミングについて普遍的な事が書いてある

普段プログラミングをやらない人が使うことも想定してか、プログラミング一般に通じる考え方を紹介している所が流石だなぁと。
マクロを書く前に問題を単純化する事、もしＣｔｒｌ＋Ｙ（やり直し）で十分な事なら態々マクロを書かない事等々。
私のような独学ベースから身に着けたクチは手段が目的化する事も少なくないため、こういう警句は助かりますね（白目

【読書メモ】コレクションと資本主義

コレクションと資本主義　「美術と蒐集」を知れば経済の核心がわかる (角川新書)

何となく図書館で目に入ったので借りてみました。
経済学が専門の水野氏と、美術取引が専門の山本氏による対談本という変わったスタイルの新書で中世欧州の真っ黒な事情が垣間見えて中々収穫の多い本でした。

気になった所、箇条書き

超低金利

１７世紀ジェノバの長期国債は1.1%台に突入した。
これは、低金利で大騒ぎしている今の先進国と同レベル。
この時代、山の斜面までワイン畑*1で埋め尽くされるほどに投資が行き渡り、現代と同様にカネ余りが生じていた。
ここに、大航海時代と出版革命がマッチし、資本が世界中に拡散、投資される事で一応資本主義は維持された。
現代の資本はどこに圧力を解放するのか？

時間は神からの預かり物

キリスト教……というかローマカトリックにとって、時間は神の物であるという概念。
古来キリスト教では、時間から価値を生じさせる利息は違法かつ非道徳であるとされていた。
現在ではイスラムでも利息はダメで、イスラム金融という出す側も受ける側も一定のリスクをお互い負うスタイルが確立している。

永遠の命を持つ存在、「法人」

上掲の「時間は神の物」という考えは更に、「法人」という永遠の命をもつ商業目的の主体が誕生する事も問題視した。
最後の審判で、法人は裁きを受けないというわけだ。

活かさず殺さず

私掠船はすべてを奪わず、事業主が採算ラインが確保できるところまでで逃がし、次の航海を諦めないようにする等々……

*1:当時の最新技術の集合体

【読書メモ】現代メディア・イベント論 パブリック・ビューイングからゲーム実況まで

現代メディア・イベント論: パブリック・ビューイングからゲーム実況まで

著者陣が社会学のセンセ方という、普段の私なら明らかに手にないタイプの社会学な内容です。
おハイソな地区の図書館にあった展示でたまたま見かけたので、手に取ってみました。
のっけからナチスお抱え建築家のシュペーアの話題が出てきたときには棚に戻しかけましたが……
SNSやテレビに跋扈している量産型ブンカジン系ではない冷静な語り口だったので読み進める事ができました。

話題はサッカーのパブリックビューイング、中国の日本アニメ字幕組と、扱ってるネタがネタだけにイマドキな話題が多いですね。
5GやVRで鼻息荒くしているメディアアート系技術屋との認識と比較すると面白いかも。

OpenPIVをWSL2上をためす その４：動画もイケる

PIVの元データを作る場合、その形式はハイスピードカメラから吐き出される動画である可能性が高いです。
それの切り出しは手動で切り出しなのかなと思ってましたが……ちゃんと動画のままやる方法が公式チュートリアルにありました。

実際のところ

元データを用意する

Githubに16Mbyteほどの動画がアップされてるので、こいつを使います。
元はYoutubeにアップロードされてる動画で、著者の許可はとったらしいです。
www.youtube.com
https://github.com/OpenPIV/openpiv-python/raw/master/openpiv/examples/test_movie/videoplayback.mp4
これを、以下のディレクトリに入れておきます。

'../test_movie/videoplayback.mp4'

とりあえず動画から切り出す

本編をそのまんま写経。

import cv2

import matplotlib.pyplot as plt
from openpiv import pyprocess, piv

vidcap = cv2.VideoCapture('../test_movie/videoplayback.mp4')
success, image1 = vidcap.read()
count = 0
U = []
V = []

while success and count < 10:
    success, image2 = vidcap.read()
    if success:
        x,y,u,v = piv.simple_piv(image1.sum(axis=2), image2.sum(axis=2),plot=True);
        image1 = image2.copy()
        count += 1
        U.append(u)
        V.append(v)

OpenCVのVideoCaptureメソッドを使ってフレーム毎に画像を切り出すスタイルみたいですね。

numpyも含めた解析

上記の後に以下を続けると……

import numpy as np

U = np.stack(U)
Umean = np.mean(U, axis=0)
V = np.stack(V)
Vmean = np.mean(V,axis=0)
fig,ax = plt.subplots(figsize=(8,8))
ax.imshow(image1,alpha=0.7)
ax.quiver(x,y,Umean,Vmean,scale=200,color='r',width=.008)
# plt.show()
plt.plot(np.mean(Umean,axis=1)*20,y[:,0],color='y',lw=3)

参考もと

OpenPIV | openpiv-python