インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

雑記

イラストAC で,自分が使えそうな素材をたくさんダウンロードしたりする日々です。

職場ではネットは使えませんから,保存,整理して使いたいときに使いたい画像に行きつけるように,,としていました。

epsにしていたらOfficeで読めると思って集めていて,実際貼り付けてみると表示されないものもあり,(;´・ω・)すこしがっかりしたところです。

でも,aiやeps形式ならIllustratorで少し修正することもできますので,その形式は大事。

自宅とかでならIllustratorから切り取って貼り付けて,と使いたい部分だけとかでもいける。

職場ではそうはいかない・・(;´・ω・)ドウシタモノカ


pngは安定して読めるので,それじゃあpngとaiまたはepsの二種類を常に持っとけば,便利なのかなぁとか

ふらふらと考えているところです。

無駄な作業にはなったのですが,

途中でai形式をeps形式に変換する,という操作をIllustratorのスクリプト機能で処理していました。

そのスクリプトはJavaScriptで書かれていたんですが,バージョンを一つ付け加えるとかならコードは読めるので,簡単にできた。

ほうほう,JavaScriptができればIllustratorにスクリプトが使えるのかぁと少し調べてみると,そこにVBScriptも使えるよ,という話がありました。

これは興味をそそる話です。

Illustratorはまだまだまったく使えていない現状なのですが,違う方向から惹かれることに出会う。

興味としてはとりあえずai形式をIllustratorでたくさん読ませておいて,それをpngで書き出して閉じるという操作をさせてみたい。

それができれば私の作業はかなり捗りそう。


まったくもって,横道のさらに横道で,手を出すべきところではありませんが,

いつかそれが役に立つ時もありそうですし,そのうちいろいろ試したいなぁと思う出来事でした。

ブログ名に偽りあり状態でしばらく来ていますが,まだVBAで遊べる日は遠い(;´・ω・)

自転車操業中。。

EXCEL HYPERLINK関数 続き小ネタ

数日前HYPERLINK関数について書きました。

とても便利だなぁと思っていますが,数式を併用することで当たり前ではありますが,少し便利な機能にもなりました。

f:id:chemiphys:20170427221229p:plain

上の黄色いセルは,色ついているだけで何の工夫もありません。日付っぽいのを入れてくれたらExcelが勝手に日付に変えてくれる。

その下のセルには次の関数

=HYPERLINK("#"&TEXT(K10,"mmdd")&"!a1",TEXT(K10,"mmdd") & "へジャンプ")

K10というのが黄色いセルです。

この仕組みだと,黄色いセルに伴いハイパーリンク先が変わるので,

ついVBAが使えると,VBAでページジャンプ機能とか作ってしまうんですが,とても簡単な関数で選べるページジャンプ機能になります。

もちろん,入力規則のリストを併用して,ジャンプ先を日付ではなく,特定のリストから選ばせることも簡単にできますね。

やっぱりExcelはすごいなぁ 便利だなぁと思う今日この頃です。

方法を制限されなければ,面倒なのでちゃちゃっとマクロで作る方に逃げちゃうわけですが,関数もいろいろ眺めるとまた新しい発見がありそうです。

続きの小ネタでした。

まだ,パワーポイントのパの字も触れない(;´▽`A``

授業の基本の教材はパワーポイントどんどん使っていますがVBA遊びまでは手がまだ戻りません。

授業で話したネタの一つとして,好きなページへのリンクを貼っておきます。

www.ptable.com

こちらのページですが,元素の導入のあたりで,授業中にも生徒のみんなの端末にアドレスを送って紹介をしています。

ウィキペディアに飛べる機能も面白いですし,各元素にまつわる動画に飛べる機能がスゴイ。

f:id:chemiphys:20170427222111p:plain

左上のウィキペディアとなっているところをクリックするとVideoとか選べます。

普通手に入らない元素についての動画が見れる。

元素の導入にうってつけのページです。

また,Photosを選ぶとセオドア・グレイさんのWeb版世界で一番美しい元素図鑑に行けます。

ここもまた,十分に面白い。

Excel HYPERLINK関数

マクロを極力使わずにワークシート関数で勝負の仕事をやっていたので,関数つながりでもうひとつ。

日報みたいなものを共有機能を使ってやりたいという話。

最初のシート作成はマクロでやりますが,日々の運用ではマクロを使いません。

でも,3ヶ月分くらいの日報をだーーーーーっと一つのファイル内に作ります。どうやって,今日や明日というページをさくっと表示するか・・

と悩み,HYPERLINK関数を使いました。


=HYPERLINK("#" & TEXT(NOW()+1,"mmdd")&"!a1","明日のページ")

=HYPERLINK("#" & TEXT(NOW(),"mmdd")&"!a1","今日のページ")


各日付のシート名 ( 4/25なら 0425 )みたいなルールでシート名をマクロで付けています。


HYPERLLINK関数内の補足ですが,

・同一ブック内なので#をつけます。
・日付のシート名はNOWを利用し,それをTEXT関数で思った書式にすることで解消しています。

これだけでその日その日に応じたハイパーリンクになるようでした。マクロじゃなくてもちゃんと飛べるようになる。


実際運用してみないとわからないわけですが,少し試した感じではちゃんと動作しているみたい。

便利な関数だなぁ。

Excel Row関数とColumn関数とVLOOKUP

仕事で,今までなんで思いつかなかったのか,びっくりしたことがありました。

ほんとに あれぇ?という感じ。

時間はないので手短に書きますが,

VLoopup関数はとても便利で,VBAでやらないときはとても感謝する関数ですが,その列を与えるときに直接値を与えてしまうため,数式のコピーがうまくできなくて,いつももやっとしていました。

f:id:chemiphys:20170424221432p:plain

第3引数の列のところです。直接値を入れてしまうもんだから,横にコピーしても数値をいちいちどうにかして変えないといけないんですよね。

今まではどこかにその列情報を書いておいてそこを参照するとか,置換を使うとかしか思いつかずに,VLOOKUPはとても便利だけどここだけはめんどくさいよなぁと思っていました。

なんででしょう,今日はふっとColumnと打ち込んでみたくなって(VBAのせいとしか思えないけど)打ち込んでみたら
f:id:chemiphys:20170424221745p:plain

普通にそれらしきワークシート関数がありまして,

期待通りの答えを返します。

=VLOOKUP($G$12,$A$1:$C$15,COLUMN(B1),FALSE)

Columnの中身を相対参照にしておけば,コピペと一緒にきちんとずれていってくれますし,足したり引いたりしてずらすとか,掛け算等を併用すればどうにでも値は操作できる。

なんでこんな簡単なこと思いつかなかったのか,愕然としつつ,これでだいぶ楽になるやんとラッキーな気分です。

ちなみにROW関数もあるので, ワークシートの INDEX関数やMATCH関数,OFFSET関数と併用してやれば大概のことはやれますね。

今まで直打ちしていた列や行の引数もコピペに対応させれるように書けますね。

とても地味で小さな発見でしたが,今後とても楽になるなーと思う出会いでした(ΦωΦ)

ちなみに引数を省略すれば,そのセルの行や列を返してくれるようです。これも応用しがいのある挙動。

もっと早く知っておくべきでした(;´▽`A``

Powerpoint VBA パワーポイントで元素記号タイピング

元素記号を20番目まで覚える。

これは,とても頭が痛い悩みなんですが,化学を学ぶ上でどうしても避けるわけにはいかない内容です。

自分が高校生の頃よりは少しましなのは,

www.youtube.com
以前NHKエレメントハンターという番組がありました。そのテーマになっているこの曲があるので導入はしやすい。

でも,とにかく覚えないといけない,という現実は変わりません。

どうしようかなぁ,自分にできる手立てはないかなぁと思い,思いついたのはタイピング。

まだまだプロトタイプですが,ちょっと作ってみました。

時間を測定してタイムアタックをするとかしないと何度もやる気は起きません。

タイムアタック機能を作れば,一部の子にはたぶん闘争心が生まれますので,一部の子には役に立つものになる気がしますし,

単純にタイピングの訓練の場が今の高校生には不足していますので,その一つとしても意義が無くもない。



はたまた別のアプローチとして3拓問題を作って,何度も繰り返すことで定着を図るとか,いろんな手はありますね。。

やっぱブログにネタとして書こうとすると,書きながらいろいろなアイディアが出ます。

なんとか今年も書かないと!

時間を作るよう努力しようと思っています。



コード
Side1 テキストボックスのChangeイベントを使います。

Option Explicit

Private Sub TextBox1_Change()

    Call 元素チェック

End Sub

標準モジュール

Option Explicit
Public 原子番号 As Long
Public 元素(1 To 20) As String, 位置(1 To 20) As String
Public 元素記号表 As Table
Const TypingText As String = "H_11,He_18,Li_21,Be_22,B_23,C_24,N_25,O_26" & _
    ",F_27,Ne_28,Na_31,Mg_32,Al_33,Si_34,P_35,S_36,Cl_37,Ar_38,K_41,Ca_42"

Sub 元素記号タイピング()
    Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(1)
    Set 元素記号表 = TargetSlide.Shapes("元素記号表").Table
    Dim i As Long
    For i = 1 To 20
        元素(i) = Split(Split(TypingText, ",")(i - 1), "_")(0)
        位置(i) = Split(Split(TypingText, ",")(i - 1), "_")(1)
    Next
    
    Slide1.TextBox1.Text = ""
    原子番号 = 1
    
    Dim c As Cell
    For i = 1 To 4
        For Each c In 元素記号表.Rows(i).Cells
            c.Shape.Fill.Visible = msoFalse
        Next
    Next

End Sub

Sub 元素チェック()
    If 原子番号 = 0 Or 原子番号 = 21 Then
        Call 元素記号タイピング
        Exit Sub
    End If
    
    Dim 元素長さ As Long
    元素長さ = Len(元素(原子番号))
    
    DimAs Long,As Long= CLng(Left(位置(原子番号), 1))= CLng(Right(位置(原子番号), 1))
    
    If Right(Slide1.TextBox1.Text, 元素長さ) = 元素(原子番号) Then
        元素記号表.Cell(,).Shape.Fill.ForeColor.RGB = vbYellow
        原子番号 = 原子番号 + 1
    End If
    
    If 原子番号 = 21 Then
        MsgBox ("おつかれさま!")
    End If
End Sub

動画
f:id:chemiphys:20170422225216g:plain

まぁ今の段階では,極めてまじめでやる気がある子しかやってくれないものなので,もちょいシステム側をきちんとしないといけません。

時間を計る機能は絶対(シツコイデスネ)

いろいろと腑に落ちないことと,やり方がわからないこと,改善すべきことがあります。

一つ目は ActiveXのテキストボックスにフォーカスを自動的に持っていく方法がわかりません。あるのかな。。?これができないとちょいつらい

二つ目は 今は元素記号が大文字1文字か,大文字と小文字のセットだよというのにこだわり,きちんと大文字にしないと認識しませんが,これだとめんどい。

シフト押す回数が多く,タイムアタックさせるとするなら,やる気をなくす要素になります。これはLike演算子で比較させて小文字でもなんとかなるようにすべきかなぁ。

三つめは腑に落ちないこと。タイピングスタートのボタンを押してもリセット処理がされないことがあります。なんでかよくわかりません。

四つ目は時間をどうやろうかなぁですね。タイマー作ったときにやったAPIのSetTimerとか持ってこないといけないかなぁと思っています。

まぁ何はともあれ,形にはしてみたいですね。。

数人でも食いつくものが作れれば,それで追加教材としては十分ですから(;´▽`A``

Powerpoint VBA epsファイルをパワーポイントに貼り付けるマクロ

今日は,4月に入って初めて空が明るいうちに帰れました。

家でも仕事もしているんですが,急ぎの仕事から本当に久しぶりに開放された気分。

新しい職場で,少しずつペースと要領をつかみ始めている気がします。

(ΦωΦ)

昨年度作ったPowerpoint VBAで作った原子模型やタイマーとかは,授業でちょこっと使うのにとても役に立っています。

熱運動も比較的早い段階で使いそうなので,

手直しをしておかないと。

科学と人間生活という科目が新設されてからずいぶん経つんですが,わたしはその科目を始めて担当できる状況になりました。

手探り状態ですが,楽しくやれそうな感じです。。


さて,問題は著作権。とにかく素材は限られています。

商用等の使用も可という素材が使い勝手はいいわけなので,そういうのも含めて日々自転車操業で教材作成に取り組みつつ,長期に困らないものを作ろうと,素材をひたすら探す。

教育上であれば無料で使えますという素材もまぁあるのでその手助けも得ながらですが,難しい時もあります。

ただ,今日は著作権者の方と電話でやり取りをして,ずいぶん楽になることがありました。

コミュニケーションは大事ですね。ほんと,痛感させられます。

今年度はなんとかなりそうな算段がつくほどの素材のあてが確保でき,気持ちも少し大きくなったとこでした。。。詳しく書くのはあまりよくないと思うので,

同じような境遇の方は,きちんと著作権者の方とお話をされると突破口があるかも,とだけ書かせていただきます。


さて,そんな中,

www.ac-illust.com

こちらのプレミアム会員に加入しました。どうも自分にとってメリットはありそうだという判断です。豊富なイラストがあり,eps形式とかで取れるものが多々。

イラストレーター形式のものもとても有用なんですが,イラストレーターで開いて立ち上げたりとちょっと面倒。epsで取れるのが楽です。


epsで取れると何が楽なのかといいますと,

パワーポイントに直接貼り付けれて,グループ化の分解から辿っていくと,パワーポイント等である程度いじれる状態まで分解できます。

色を変えたりとかが最低限できる。

頂点編集もできることが多いです。

なのでとてもありがたいんですね。ベクトルデータなので,拡大等にも便利です。

ただ,Windowsの標準機能でプレビューが見れないので,

パワーポイントにぺたぺた貼っていけば使いやすいよなーということで,

スライド1枚1枚にフォルダ内のepsファイルを貼り付ける,というマクロを作りました。

短いマクロですが,なかなか自分には便利です。

Option Explicit

Sub 画像挿入()
    Dim strFileName As String
    Dim SlideNo As Long
    strFileName = Dir(ActivePresentation.Path & "\", vbNormal)
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> ""
        '各ファイルに行う作業----------------------
        If strFileName Like "*.eps" Then '<> ActivePresentation.Name Then
            
            SlideNo = ActivePresentation.Slides.Count
            ActivePresentation.Slides.Add SlideNo + 1, ppLayoutBlank
            
            Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(SlideNo + 1)
            
            TargetSlide.Shapes.AddPicture ActivePresentation.Path & "\" & strFileName, msoFalse, msoTrue, 0, 50
            
            With TargetSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 200, 50)
                .TextFrame.TextRange.Text = strFileName
            End With
            
        End If
        '-------------------------------------------
        ' 次のファイル名を取得
        strFileName = Dir()
    Loop
End Sub

これだけ。。

epsファイルがたくさんあるとこに,このマクロ入りのパワーポイントファイルを入れて,マクロを動かすと,

f:id:chemiphys:20170422011203p:plain

こんな感じです。
f:id:chemiphys:20170422011256p:plain

こんな風にばらばらにできるし,
f:id:chemiphys:20170422011351p:plain
パワーポイントはスライドショーの機能の一つにサムネイル表示が2013くらいからあるので,簡易ビュアーにもなりますし,

フリーソフトが簡単には入れれないような職場ではマクロとの併用でepsファイルビュアー的な使い方できるなーと思いました。

Powerpoint VBA 道や線路を描くマクロ

皆さんのブログは楽しく眺めさせてもらっているんですが,とにかく時間が無い毎日を送っているところで,まったく自分では書けていませんでした。

暇だけではありませんね,ネタもすぐにはポンと出てこない。

とりあえず,半端ない忙しさの毎日ですので,仕事を家でも職場でもやっている毎日。

嫌いならブラック極まりないですね。

好きなことなので,どこまでが趣味でどこまでが仕事か判別しにくいところ。

ストレスフリーではあります。(ΦωΦ)


本題に。。

数年間使われ続けていた地図を含む資料を作り直して印刷屋さんにお願いする,という仕事も同時並行で来まして,

すげーめんどくさいなぁと思いながらも,その地図を使い続けるのが気持ち的に許せない。

海岸線などはトレースしていけばある程度描いてくれるので,それでまぁできました。

学校での使用については問題ないと書かれていたので,国土地理院さんの地図を利用させていただいて,Illustratorである程度トレース。

さて,道路全部描くとうざいので,通学に使われている道だけを描かないといけないんですが,道って少なくとも二本線くらいでは描かないと,というところです。

電車の路線はもちょいめんどくさいですよね。。

そこで,それをなんとかするマクロを作ってみました。すごい単純ですが,私にはとてもいいものとなりました。(ΦωΦ)

時間が無いので雑ですみませんが,結果とコードを載せます。

f:id:chemiphys:20170416135055p:plain 元絵です
f:id:chemiphys:20170416135122p:plain 曲線でなぞって
f:id:chemiphys:20170416135155p:plain マクロで修正

こんなマクロです。

Option Explicit

Sub MakeRoad()
    Dim roadOutline As Shape
    Dim roadInline As Shape
    
    Set roadOutline = ActiveWindow.Selection.ShapeRange(1)
    Set roadInline = roadOutline.Duplicate(1)
    
    roadOutline.Line.Weight = 4.5
    roadOutline.Line.ForeColor.RGB = vbBlack
    roadInline.Line.Weight = 2.25
    roadInline.Line.ForeColor.RGB = vbWhite
    roadInline.Left = roadInline.Left - 12
    roadInline.Top = roadInline.Top - 12
    
    Dim ActiveSlide As Slide: Set ActiveSlide = ActiveWindow.View.Slide
    ActiveSlide.Shapes.Range(Array(SIndex(roadOutline), SIndex(roadInline))).Group
End Sub
Sub MakeRailroad()
    Dim roadOutline As Shape
    Dim roadInline As Shape
    
    Set roadOutline = ActiveWindow.Selection.ShapeRange(1)
    Set roadInline = roadOutline.Duplicate(1)
    
    roadOutline.Line.Weight = 4.5
    roadOutline.Line.ForeColor.RGB = vbBlack
    roadInline.Line.Weight = 2.25
    roadInline.Line.ForeColor.RGB = vbWhite
    roadInline.Line.DashStyle = msoLineLongDash
    roadInline.Left = roadInline.Left - 12
    roadInline.Top = roadInline.Top - 12
    
    Dim ActiveSlide As Slide: Set ActiveSlide = ActiveWindow.View.Slide
    ActiveSlide.Shapes.Range(Array(SIndex(roadOutline), SIndex(roadInline))).Group
End Sub

Sub Edit2ndItemNode()
    Dim targetShape As Shape: Set targetShape = ActiveWindow.Selection.ShapeRange(1).GroupItems(1)
    targetShape.Select
End Sub

Function SIndex(ByVal targetShape As PowerPoint.Shape) As Long
    Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(targetShape.Parent.SlideIndex)
    
    If targetShape.Child = msoTrue Then '完全に真似させてもらった。グループ内図形の場合は親を返す
        Let SIndex = SIndex(targetShape.ParentGroup)
        Exit Function
    End If
    
    Dim db As Object: Set db = CreateObject("Scripting.Dictionary")
    Dim s As Shape
    Dim i As Long: i = 1
    
    For Each s In TargetSlide.Shapes
        db(s.Id) = i
        i = i + 1
    Next
    
    Let SIndex = db.Item(targetShape.Id)
    
End Function

MakeRoadというのが,一本線を 道のような二重線にします。
MakeRailroadというのが,一本線を 路線のようにします。白の点線のっけてるだけです。

ちょこっと編集したいというときに,二本の線を重ねていますので,下の線を選ぶのが大変です。
その時のために,下の黒線(グループ内のインデックスでは1となります。)を選ぶマクロがEidt2ndItemNodeです。
選ぶとこまではできますが,編集状態にするやり方はわからないので,キーボードにあるメニュー出すキーを押して頂点の編集を選べば下の線が編集できます。
完全に自分用マクロです(´▽`) '`,、'`,、

こんなものが役に立つ人がいるのかわかりませんが,とりあえず目新しいことが書けるネタだったので書きました。

今年度安定して記事が書けるまでとりあえず仕事がんばらないとなぁ( ´ー`)フゥー...

Duplicate後の図形のずれって私が前扱ったときは15だったと思うんですが,今回数値を書き出させると12でした。

何に依存するのかなぁ。

もし,きちんと図形が重ならなくてだめやんとなった方は,

    roadInline.Left = roadInline.Left - 12
    roadInline.Top = roadInline.Top - 12

イミディエイトウィンドウでずれの数値を確認して,上記部分をいじってもらえば,どうにかなると思われます。