読者です 読者をやめる 読者になる 読者になる

Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

Powerpoint VBA 表のそれぞれのセルの文字に処理を行う

さっきの続きです。

ひさびさにPowerpointのVBAのことが書けるのでとても気分がいいです。

タイトル詐欺になるので!

やっていることはさっきの続きで,たくさんのセルや文字があるので,こういう時こそマクロの出番だよ,というものです。

教材作成と並行していますので,勢いで書いています。スミマセン。

コードはこちら。さくっと使えるようにということで,選んだテーブルに処理を行います。

Sub 書式調整()
    Dim TargetTable As Table: Set TargetTable = ActiveWindow.Selection.ShapeRange.Table
        
    Dim r As Row, c As Cell, tr As TextRange
    For Each r In TargetTable.Rows
        For Each c In r.Cells
            For Each tr In c.Shape.TextFrame.TextRange.Characters
                If tr = Chr(11) Then tr.Delete
                If IsNumeric(tr) = True Then
                    tr.Font.Size = 12
                    tr.Font.Subscript = msoTrue
                Else
                    tr.Font.Size = 14
                End If
                
            Next
        Next
    Next
        
End Sub

For Eachだらけですね(ΦωΦ)好きなんです。

Table → Rows → Cells → Characters → 各Character (オブジェクトとしてはTextRangeオブジェクトになります)
と全てコレクションオブジェクトなので,For eachで降りていけます。RowsはColumnsでもいけるようです。
アクセスする順番は変わりますけど。。

たまたまわたしがやったやつでは, 改行が Chr(11)でしたので,邪魔なので削除しています。

数字は小さくしたかったので IsNumericで判断して,小さくし,さらに下付き(SubScript)にしています。

そうでなかったらSizeを14にする。

あとは数値をトライアンドエラーで自分好みのサイズの組み合わせにしていきます。

f:id:chemiphys:20170327224624p:plain
※テキストが 金属と非金属逆でした ハズカシ(;´▽`A`` 修正

私好みな感じになりました。

こんなのいちいちやっていると大変なので,これはマクロの出番ですね。

Powerpoint VBA ハイパーリンクを全て削除するマクロ

教材づくりに必死な毎日です。

使えるものは使わせてもらおうと思うほどせっぱ詰まっています。

pixabayは出会ってとてもよかった。非常に使いやすいです。

来年はどうやら,フリー素材と自作素材で勝負しないといけない状況になったようです。

最大限に利用しつつ,自作に織り交ぜていく。


普遍的な文・式については著作権は無いようですので,

問題なさそうな場合はコピぺを利用することはあります。

その時,ハイパーリンクが邪魔なことがありますので,消す方法を考えました。

探すのに時間がまぁまぁかかったので,備忘録として書いたコードを載せます。

周期表をwikipediaから頂いてきて,パワーポイントに貼ったものの膨大なリンクをどうしようか,というところです。

VBAコード

Option Explicit

Sub DelHyperLink()
    Dim TargetSlide As Slide: Set TargetSlide = ActiveWindow.View.Slide
    Dim h As Hyperlink
    For Each h In TargetSlide.Hyperlinks
        h.Delete
    Next
End Sub

Activewindow.View.Slideという設定をしていますので,アクティブなスライドに対して処理を行います。

f:id:chemiphys:20170327215006p:plain
下線がたくさんあり,リンクを一つ一つ消すと大変です。

上記のマクロを実行すると,

f:id:chemiphys:20170327215100g:plain
そのスライドにあるハイパーリンクを全部消してくれます。
あんまり意味のない動画ですね(;´▽`A``

まぁ消えます。

さて,なぜ上のように書けるのかという話ですが,

f:id:chemiphys:20170327215239p:plain

こんなところに収められているからです。コレクションなので,For Eachが使えます。

実益を兼ねて,久々にパワーポイントにかかわるマクロが書けて良かった。

画像素材探索

教材作成をしていると,いろいろな素材を探しにネットに出かけ,使用できるかどうかを思案する時間が長くなります。

なので,このブログのタイトルとは異なりますが,雑記ではなく,教材素材としてカテゴリ分けしようと考えました。

備忘録デスカラ(ΦωΦ)

ラボアジエという化学者がいて,この方の画像を探していたら

www.flickr.com

こちらにたどり着きました。聞いたことあるとこだなぁと思い,調べてみた。

こちらで詳しく書かれているようです。
nanapi.com

で,どうしても教材に利用しようとすると,その全体ではなく部分を使いたい場合が多い。

なので,著作権が放棄または事実上使用可能なものにのみ興味があります。


今回私が探していた素材はこちら
Image from page 354 of "Traité élémentaire de chimie : présenté dans un ordre nouveau et d'après les découvertes modernes ; avec figures" (1789)

画像に関する情報はこちら
f:id:chemiphys:20170326113327p:plain
f:id:chemiphys:20170326113433p:plain

no known copyright restrictions というライセンスカテゴリがあります。

おそらく私が扱いたい素材のほとんどはこのカテゴリ内になると思われます。

著作権者からの許可などはないが、写真の利用については制限はない」ということを意味しており、
撮影日から所定の年月が過ぎたためにパブリックドメインとなっていたり、
パブリックドメインではないものの施設側に著作権をコントロールする意志がない、
あるいは制限無しの利用を許諾する権利が施設側にあるといった理由で、自由な利用が可能となっている。

この表現から考えて,わたしが使用するにあたり,問題はなさそうな気がします。
パブリックドメインではないよ,ということは留意しつつ扱い方には気を付けながらでも,積極的に使わせてもらおうと思うページでした。


著作権者不明の写真コレクション「The Commons」、Flickrが新ページ − @IT
Brooklyn Museumに所蔵される写真がFlickrで公開される | スラド YRO

Excel VBA セルの値だけを入れ替えるマクロ

さて,いつになったらパワーポイントのマクロに戻れるのか。

実務のほうがそのモードに入るまでもうちょいかかりそう。

どうも春から生活が変化しそうです。楽しみです。

さて,高等学校では4月になると時間割が作られます。

時間割作成ソフトというのがあるので,その機能である程度までは形にするんですが,どうしても最後のほうの書式は自分でカスタマイズしていきたいもの。

また,その時間割のデータをいろんな形に加工して利用するので,そこはExcelVBAの出番。

いろいろな書式が施されているうえで,値だけ入れ替えたいんだよね,というケースに頻繁に出会う仕事です。

その準備をしておこうと思いましたので,書式を変えずデータだけ入れ替える,というマクロを用意しました。

ある程度の大きさの連続範囲を入れ替えるということもよくやるので,そのイメージでコードを書いた。

あと,ApplicationオブジェクトのmacroOptionsでショートカットキーを設定する,というのも知りませんでしたので,そちらも使用。

うん,これは短いけど使えそうだ。

VBAコード(改善前)

Option Explicit
Sub SetShortcut()
    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r"
End Sub

Sub RemoveShortcut()
    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:=""
End Sub

Sub ReplaceValues()
    Dim SelectionRange As Range: Set SelectionRange = Selection

    If SelectionRange.Areas.Count <> 2 Then Exit Sub
    
    Dim ColumnsCount As Long, RowsCount As Long
    ColumnsCount = SelectionRange.Areas(1).Columns.Count
    RowsCount = SelectionRange.Areas(1).Rows.Count
    
    Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select
    Set SelectionRange = Selection
    
    Dim tmp(): ReDim tmp(1 To 2, 1 To RowsCount, 1 To ColumnsCount)
    Dim i As Long, j As Long, k As Long
    
    For k = 1 To 2
        For i = 1 To RowsCount
            For j = 1 To ColumnsCount
                tmp(k, i, j) = SelectionRange.Areas(k).Value2(i, j)
            Next
        Next
    Next
    
    With SelectionRange.Areas(1)
        For i = 1 To RowsCount
            For j = 1 To ColumnsCount
                .Cells(i, j) = tmp(2, i, j)
            Next
        Next
    End With
    
    With SelectionRange.Areas(2)
        For i = 1 To RowsCount
            For j = 1 To ColumnsCount
                .Cells(i, j) = tmp(1, i, j)
            Next
        Next
    End With
End Sub

VBAコード(改善後)

追記になります。imihitoさんからのご指摘を適用してみました。

Option Explicit
Sub SetShortcut()
    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r"
End Sub

Sub RemoveShortcut()
    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:=""
End Sub

Sub ReplaceValues()
    Dim SelectionRange As Range: Set SelectionRange = Selection

    If SelectionRange.Areas.Count <> 2 Then Exit Sub
    
    Dim ColumnsCount As Long, RowsCount As Long
    ColumnsCount = SelectionRange.Areas(1).Columns.Count
    RowsCount = SelectionRange.Areas(1).Rows.Count
    
    Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select
    Set SelectionRange = Selection
    
    Dim tmp
    
    With SelectionRange
        tmp = .Areas(1).Value2
        .Areas(1).Value2 = .Areas(2).Value2
        .Areas(2).Value2 = tmp
    End With
    
End Sub

めちゃくちゃ短くなり,しかもシンプルになりました。イイですね。すばらしい。。

使い方

使用法はいたってシンプル
まずSetShortCutマクロを一度実行をしておいてください。
この設定はブックに保存されるらしいので,一度設定すればこのブックを開くとショートカットはもう設定されたままになっています。

replaceなので ctrl+r に設定していますが,隣をコピーする,というショートカットを愛用している方はほかのショートカットにしてください。

解除方法としてRemoveShotrCutマクロを準備しています。

面白い仕組みですね。初めて知った内容でした。


ctr+rを押すと選択している範囲1と範囲2の値が入れ替わります。

危険でもありますが,利便性のために,範囲2の形は範囲1の形に強制的に合わせられます。

なので,範囲2は範囲2の左上のセルを指定するだけで十分です。

値を入れ替えているだけなので,もう一度ctrl+rを押すともとに戻せます(ΦωΦ)


一応数式を同じようにすることも簡単そうでした。Value2ではなくFormulaR1C1とかを取得して書かせるようにしたらたぶんできる。

でも,それは良し悪しで,値を入れ替えるというのがわたしの目的には適していたので今回は値の入れ替えをします。

コードの説明

    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r"
    Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:=""

ショートカットの設定と,解除のところです。ctrl+shift+r を設定したい場合は ShortCutKey:="R"にすればよいそうです。

    Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select
    Set SelectionRange = Selection

複数のセル範囲を得るためにUnionを使っています。
また,SelectionReangeを変化させたかったので,Setしなおしています。

    For k = 1 To 2
        For i = 1 To RowsCount
            For j = 1 To ColumnsCount
                tmp(k, i, j) = SelectionRange.Areas(k).Value2(i, j)
            Next
        Next
    Next

ここは無念でした。For Eachで書きたかった>< でも思いつかなかった。
そのこだわりは無意味だったので,素直に書きました。
離れた数か所のセルを選んでいるときは,それぞれはAreas(インデックス)に収められます。

そして,これも私はあまり使ったことなかったValue2プロパティ
f:id:chemiphys:20170325121115p:plain
値を二次元で格納してくれていましたので,今回利用させてもらいました。便利だなぁ。

ちなみに
f:id:chemiphys:20170325121217p:plain
FormulaR1C1も同じように格納されています。

今回は3次元の配列が便利だったので,tmpは3次元の配列です。

動作動画

f:id:chemiphys:20170325120205g:plain

著作権 少し調べた。

著作権のことを少し調べています。

まず,日本では著作権の期限は死後50年でそれ以後はパブリックドメインとしての使用ができる,ということのようです。
著作権の保護期間はどれだけ? | 著作権って何? | 著作権Q&A | 公益社団法人著作権情報センター CRIC

chosakuken-kouza.com

いくつかのページを回って確認してみたので,間違いはないでしょう。

そして,前述の下の方のページで,

このような記述があります。

インターネット上にはパブリックドメインとなった作品を集めたサイトなども存在し、これらの著作物は自由にコピーや使用ができます。
(例:pixabay:パブリックドメインの写真を扱うサイト
青空文庫:著作権切れの小説を公開しているサイト)

青空文庫は知っていましたが,pixabayは知りませんでした。

pixabayを試しに見に行きました。

Free Images - Pixabay

f:id:chemiphys:20170325002025p:plain

使えそうな絵や写真がたくさん。

パブリックドメインなので,これらを自分好みにトレースするのもきっと自由ですね。
CC0について ― “いかなる権利も保有しない” « Science Commons – サイエンス・コモンズ翻訳プロジェクト

知らなかった もったいない。

wikipediaのパブリックドメイン素材

死後50年を超えた(国によっては最長100年なのかな)著作物

先ほどのpixabayの素材および

これらのトレースをしたもの。

どうもこれらは自由に使って差し支えないようです。

ふむふむ。これはありがたいなぁ。

どこかに信用できる確証を求めたいところですね。

確証がとれるなら,トレースしたパワーポイントの画像をアップできるんだけどなぁ。

今はほぼ大丈夫と思いつつも,そこまで拡散するほどの自信は無いので,トレース画像のアップはやめておきます。

でも,自分で使う範囲でなら,もう使える自信はでてきました。

教材作成をする上でかなりの自由度を得た気がします。

追記 まだ調べていました。

ハーバード大学図書館、パブリックドメインの資料をデジタル化したものは自由利用でオンライン公開する方針を公表 | カレントアウェアネス・ポータル

Harvard Library Policy on Access to Digital Reproductions of Works in the Public Domain | Harvard OSC

求めている答えはまさにこれですね。パブリックドメインのものをこのハーバード大学図書館がデジタル化して公開しているものについてはパブリックドメインとしますよ,と明記されているようです。

(/・ω・)/わーい

かなり安心が増します。

絵のことを書くと著作権のこと調べないといけないですね。

まだ時間がとれていませんので,調べれてはいませんが,

今回とても気に入った絵と出会い,原本のデータとも幸いにも出会うことができ,

AdobeStockのためにライセンスを買っていた IllustratorCC,PhotoShopCCを使ったトレースがうまくいって,

自分では満足のいく教材の図が書けました。

元素等の話をする上で,私を助けてくれることは間違いないです。

元々ゲーマーで,ファンタジーな世界が大好きです。

なので,前回の図はがっつりストライクなんです。

再掲

f:id:chemiphys:20170323001056p:plain


元絵 エンペドクレスの4元素の絵
Four elements at de responsione mundi et de astrorum ordinatione


さて,デジタルの場で話をしているわけなので,無視しちゃいけないのは著作権。

紙であれば,授業の場ではある一定条件での使用を認められる職種ではあるわけですが,デジタルではそうはいかない。。

基本はパブリックドメインのものを利用するかCC表示に従い行動,表示するよう努めています。

今回のはWikipediaのほうにこう書かれています。


The author died in 1478, so this work is in the public domain in its country of origin and other countries and areas where the copyright term is the author's life plus 100 years or less.

This work is in the public domain in the United States because it was published (or registered with the U.S. Copyright Office) before January 1, 1923.

死後100年経ってるから,パブリックドメインでいいよ。ということですよね。。


古めかしい素材が好きなので,この条件でいうなら,わたしが利用できる図というのはまだまだたくさん眠っているのでしょうし,

なぞるのは大変でも今回のようにトレース機能を利用すればできることはかなり広がります。

じゃあ画像を見るために通過させていただいているハーバード図書館の権利を侵害していないか。というのも気になり,そちらの著作権のページを見たら・・

www.harvard.edu


よく意味がわかりませんでした(;´▽`A``

原書の著作権を侵害することは許しませんし,そのような例を見つけたら報告してくださいね,

と書いているように私は受け取っています。


原書の著作権に準じますよということであれば,今回私がとった行動はたぶん著作権的には問題ないんだろうなぁというところ。。

パブリックドメインの素材はWikipediaにたくさんあります。

CC表示をきちんとすればいいよ,という素材もたくさんありますし,立場上そのような表示は積極的に使い,他の方の著作物を使う場合は表示をするようにしようね,というふうに自然な流れで授業に加えられます。

イメージの元を他の著作物からもらう場合もありますね。

Adobe Stockのsapunkele という方の絵が大好きです。この方の絵を見ながら人を描く練習をしています。

あまりにもシンプルなヒトの絵なので,頭が丸で手足がある,,というもので 誰が書いてもヒトってこんな感じじゃね?という絵ですが,バランスが絶妙。

画像は多数ライセンス取得もしていますが,そこのヒトたちを見て,自分が望む形のヒトを描く助けになる。



著作権のことは,聞かれたときにきちんと答えられるように,ちゃんと確認しないといけないんだろうなぁ。

(;´▽`A``

VBAちょい組んでないなぁ・・・ ネタを探さないと・・