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という設定をしていますので，アクティブなスライドに対して処理を行います。
下線がたくさんあり，リンクを一つ一つ消すと大変です。
上記のマクロを実行すると，
そのスライドにあるハイパーリンクを全部消してくれます。
あんまり意味のない動画ですね(;´▽｀A``
まぁ消えます。
さて，なぜ上のように書けるのかという話ですが，
こんなところに収められているからです。コレクションなので，For Eachが使えます。
実益を兼ねて，久々にパワーポイントにかかわるマクロが書けて良かった。
画像素材探索
教材作成をしていると，いろいろな素材を探しにネットに出かけ，使用できるかどうかを思案する時間が長くなります。
なので，このブログのタイトルとは異なりますが，雑記ではなく，教材素材としてカテゴリ分けしようと考えました。
備忘録デスカラ（ΦωΦ）
ラボアジエという化学者がいて，この方の画像を探していたら
こちらにたどり着きました。聞いたことあるとこだなぁと思い，調べてみた。
こちらで詳しく書かれているようです。
nanapi.com
で，どうしても教材に利用しようとすると，その全体ではなく部分を使いたい場合が多い。
なので，著作権が放棄または事実上使用可能なものにのみ興味があります。
今回私が探していた素材はこちら
画像に関する情報はこちら
no known copyright restrictions というライセンスカテゴリがあります。
おそらく私が扱いたい素材のほとんどはこのカテゴリ内になると思われます。
著作権者からの許可などはないが、写真の利用については制限はない」ということを意味しており、
撮影日から所定の年月が過ぎたためにパブリックドメインとなっていたり、
パブリックドメインではないものの施設側に著作権をコントロールする意志がない、
あるいは制限無しの利用を許諾する権利が施設側にあるといった理由で、自由な利用が可能となっている。
この表現から考えて，わたしが使用するにあたり，問題はなさそうな気がします。
パブリックドメインではないよ，ということは留意しつつ扱い方には気を付けながらでも，積極的に使わせてもらおうと思うページでした。
著作権者不明の写真コレクション「The Commons」、Flickrが新ページ − ＠IT
Brooklyn Museumに所蔵される写真がFlickrで公開される | スラド YRO
Excel VBA セルの値だけを入れ替えるマクロ
さて，いつになったらパワーポイントのマクロに戻れるのか。
実務のほうがそのモードに入るまでもうちょいかかりそう。
どうも春から生活が変化しそうです。楽しみです。
さて，高等学校では４月になると時間割が作られます。
時間割作成ソフトというのがあるので，その機能である程度までは形にするんですが，どうしても最後のほうの書式は自分でカスタマイズしていきたいもの。
また，その時間割のデータをいろんな形に加工して利用するので，そこは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を押すと選択している範囲１と範囲２の値が入れ替わります。
危険でもありますが，利便性のために，範囲２の形は範囲１の形に強制的に合わせられます。
なので，範囲２は範囲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プロパティ
値を二次元で格納してくれていましたので，今回利用させてもらいました。便利だなぁ。
ちなみに
FormulaR1C1も同じように格納されています。
今回は3次元の配列が便利だったので，tmpは3次元の配列です。
動作動画
著作権 少し調べた。
著作権のことを少し調べています。
まず，日本では著作権の期限は死後５０年でそれ以後はパブリックドメインとしての使用ができる，ということのようです。
著作権の保護期間はどれだけ？ | 著作権って何？ | 著作権Q&A | 公益社団法人著作権情報センター CRIC
いくつかのページを回って確認してみたので，間違いはないでしょう。
そして，前述の下の方のページで，
このような記述があります。
インターネット上にはパブリックドメインとなった作品を集めたサイトなども存在し、これらの著作物は自由にコピーや使用ができます。
(例：pixabay：パブリックドメインの写真を扱うサイト
青空文庫：著作権切れの小説を公開しているサイト)
青空文庫は知っていましたが，pixabayは知りませんでした。
pixabayを試しに見に行きました。
使えそうな絵や写真がたくさん。
パブリックドメインなので，これらを自分好みにトレースするのもきっと自由ですね。
CC0について ― “いかなる権利も保有しない” « Science Commons – サイエンス・コモンズ翻訳プロジェクト
知らなかった もったいない。
wikipediaのパブリックドメイン素材
死後５０年を超えた(国によっては最長１００年なのかな)著作物
先ほどのpixabayの素材および
これらのトレースをしたもの。
どうもこれらは自由に使って差し支えないようです。
ふむふむ。これはありがたいなぁ。
どこかに信用できる確証を求めたいところですね。
確証がとれるなら，トレースしたパワーポイントの画像をアップできるんだけどなぁ。
今はほぼ大丈夫と思いつつも，そこまで拡散するほどの自信は無いので，トレース画像のアップはやめておきます。
でも，自分で使う範囲でなら，もう使える自信はでてきました。
教材作成をする上でかなりの自由度を得た気がします。
追記 まだ調べていました。
ハーバード大学図書館、パブリックドメインの資料をデジタル化したものは自由利用でオンライン公開する方針を公表 | カレントアウェアネス・ポータル
求めている答えはまさにこれですね。パブリックドメインのものをこのハーバード大学図書館がデジタル化して公開しているものについてはパブリックドメインとしますよ，と明記されているようです。
(/・ω・)/わーい
かなり安心が増します。
絵のことを書くと著作権のこと調べないといけないですね。
まだ時間がとれていませんので，調べれてはいませんが，
今回とても気に入った絵と出会い，原本のデータとも幸いにも出会うことができ，
AdobeStockのためにライセンスを買っていた IllustratorCC,PhotoShopCCを使ったトレースがうまくいって，
自分では満足のいく教材の図が書けました。
元素等の話をする上で，私を助けてくれることは間違いないです。
元々ゲーマーで，ファンタジーな世界が大好きです。
なので，前回の図はがっつりストライクなんです。
再掲
元絵 エンペドクレスの４元素の絵
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.
死後１００年経ってるから，パブリックドメインでいいよ。ということですよね。。
古めかしい素材が好きなので，この条件でいうなら，わたしが利用できる図というのはまだまだたくさん眠っているのでしょうし，
なぞるのは大変でも今回のようにトレース機能を利用すればできることはかなり広がります。
じゃあ画像を見るために通過させていただいているハーバード図書館の権利を侵害していないか。というのも気になり，そちらの著作権のページを見たら・・
よく意味がわかりませんでした(;´▽｀A``
原書の著作権を侵害することは許しませんし，そのような例を見つけたら報告してくださいね，
と書いているように私は受け取っています。
原書の著作権に準じますよということであれば，今回私がとった行動はたぶん著作権的には問題ないんだろうなぁというところ。。
パブリックドメインの素材はWikipediaにたくさんあります。
CC表示をきちんとすればいいよ，という素材もたくさんありますし，立場上そのような表示は積極的に使い，他の方の著作物を使う場合は表示をするようにしようね，というふうに自然な流れで授業に加えられます。
イメージの元を他の著作物からもらう場合もありますね。
Adobe Stockのsapunkele という方の絵が大好きです。この方の絵を見ながら人を描く練習をしています。
あまりにもシンプルなヒトの絵なので，頭が丸で手足がある，，というもので 誰が書いてもヒトってこんな感じじゃね?という絵ですが，バランスが絶妙。
画像は多数ライセンス取得もしていますが，そこのヒトたちを見て，自分が望む形のヒトを描く助けになる。
著作権のことは，聞かれたときにきちんと答えられるように，ちゃんと確認しないといけないんだろうなぁ。
(;´▽｀A``
VBAちょい組んでないなぁ・・・ ネタを探さないと・・
塗った!
時間と疲れに負けて，最後らへんテキトーに塗りましたが，
なかなか雰囲気はいい。
好みでちょい派手目になります(;´▽｀A``
教材にちょこっと載せる分にはこれで十分かなぁ。
大変だったけど雰囲気が出ました。（ΦωΦ）
COUNTIFSを知らなかったことに衝撃
今日も元気にお絵かきしています。
フォトショップとイラストレーターも覚えないとですね。こんなすごいものなんだなぁ。トレーススゴイ。
まともに使おうとは思っていませんが，このトレースには驚きます。
世の中便利なものがたくさん。。
フリーフォームなのに頂点編集ができないものなどができちゃうので，ばらばらにしているところです。
この文字の雰囲気，火の雰囲気，，タマラナイモノガアリマス。
さて，朝けっこう塗ってしまってたのを置いてきたので，また家で練習しています。
何度もやると，そのたびに発見があるからスバラシイ。
そうそう，今日こんな便利な関数あったのね，と知らずにいた数年間を後悔している関数があります。
COUNTIFとは長いこと友達なんですが，COUNTIFS とかあったんですね・・(;´▽｀A``
なんだこのチート関数は・・というくらいの衝撃が私にはあります。
VBAがあると，なんでもとりあえず自分でだいたいできてしまうので，ワークシート関数に疎いことがあるんですが，今回もまさにそれ。。
COUNTIF単体でも十分高機能ですが，いくつもの検索条件でできるとかシラナカッタヨ。
すごいなぁとしみじみ。
EXCEL2007からだそうですね・・ 何年間か残念です。。
知らなかったからこそ集計関連のVBAの腕が上がったんだと，自分をなぐさめる位しかありません(;´▽｀A``
