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

Powerpoint VBAを使おう!

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

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

Powerpoint VBA

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

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

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

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

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

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

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

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

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

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



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

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

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

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

さて,スタート段階のファイルとコードと画面を載せます。

元素タイピング.pptm

コード
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ファイルをパワーポイントに貼り付けるマクロ

Powerpoint VBA

今日は,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 道や線路を描くマクロ

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

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

連続数字を表に入れるときのメモ

VBA Powerpoint VBA

データを文字列を介していろいろな形に加工するという作業をよくやります。

わかってしまえば,たやすい事なんですが,思いつかないとしばらく悩まないといけないポイントがあり,

見事にはまった後解決した記憶がありましたので,たぶん多くの方にはつまんないことですが,メモとして書きます。




1,2,3,4,5,6,7,8,9,10,11,12,13,14,15


  ↓ 5列の表にしたい

1 2 3 4 5
6 7 8 9 10
11 12 13 14 15

こういうことをやりたいことがあるんです。けっこう頻繁に。。


商と余りを使えばいい。

とても簡単なんですが,元の数字をそのまま商と余りで処理しようとすると,意外に難しいことになります。

1 2 3 4
5 6 7 8 9
10 11 12 13 14
15

わたしみたいにあんまり物を考えない人はごり押しします。If文でごりごり書き出したり,

do loopなどでカウンタを条件に合わせてリセットすることで対処したり。。

(;´▽`A``ホントコマッタモノデス。


さて,引っ張りすぎですね。答えは簡単

0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15

0から始まる数値なら,5で割り算をした商と余りを用いれば

0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
0 0 0 0 0 1 1 1 1 1 2 2 2 2 2
余り 0 1 2 3 4 0 1 2 3 4 0 1 2 3 4

きれいにできあがります。
気づいた時の自分に対するあきれようはすごいですが,しばらくするとすぐ忘れるモノデス(;´▽`A``

さて,パワーポイントのVBAをだいぶ忘れているので,思い出すためにパワーポイントのVBAコードで試します。

f:id:chemiphys:20170410224414p:plain
パワーポイントのスライド1に3つの表をこのSSのように並べます。それぞれに付けた名前はマクロで使用します。
場所や大きさは適当ですが,列数は守る必要があります。または,コードのほうを好きに変えるのもいいですね。

標準モジュールはこちら

Sub test()
    
    Dim TargetSlide As Slide: Set TargetSlide = ActiveWindow.View.Slide
    
    Dim SourceTable As Table: Set SourceTable = TargetSlide.Shapes("元表").Table
    Dim PasteTable As Table: Set PasteTable = TargetSlide.Shapes("貼付表5列").Table
    Dim PasteTable2 As Table: Set PasteTable2 = TargetSlide.Shapes("貼付表3列").Table
    
    Dim DataCollection As Collection: Set DataCollection = New Collection
    
    Dim r As Cell
    For Each r In SourceTable.Rows(1).Cells
        DataCollection.Add r.Shape.TextFrame.TextRange.Text
    Next
    
    Dim i As Long, tmp As String
    For i = 0 To DataCollection.Count - 1
        tmp = DataCollection(i + 1)
        PasteTable.Cell(Int(i / 5) + 1, i Mod 5 + 1).Shape.TextFrame.TextRange = tmp
    Next
    
    For i = 0 To DataCollection.Count - 1
        tmp = DataCollection(i + 1)
        PasteTable2.Cell(Int(i / 3) + 1, i Mod 3 + 1).Shape.TextFrame.TextRange = tmp
    Next

End Sub

実行すると,
f:id:chemiphys:20170410224645p:plain

このとおりです。

コードの補足を少しします。

    Dim TargetSlide As Slide: Set TargetSlide = ActiveWindow.View.Slide

対象のスライドからオブジェクトの指定が始まることがほとんどなので,対象のスライドをオブジェクト変数に入れます。
いろいろな方法がありますが,アクティブなスライドを捕まえる書き方の一つです。imihitoさんから教えていただいたヤツデス。

    Dim SourceTable As Table: Set SourceTable = TargetSlide.Shapes("元表").Table
    Dim PasteTable As Table: Set PasteTable = TargetSlide.Shapes("貼付表5列").Table
    Dim PasteTable2 As Table: Set PasteTable2 = TargetSlide.Shapes("貼付表3列").Table

表に名前がついているように感じますが,パワーポイントの場合いろいろなものはShapeオブジェクトとして扱われます。
各Shapeオブジェクトの中のTable のように指定するわけです。

    Dim DataCollection As Collection: Set DataCollection = New Collection

要素数を決めないで値を放り込むのに使えるということで,Collectionを使いました。配列を使ってもいいかもしれません。

    Dim r As Cell
    For Each r In SourceTable.Rows(1).Cells
        DataCollection.Add r.Shape.TextFrame.TextRange.Text
    Next

パワーポイントの表については,For Eachステートメントはとても使いにくいんですが,
Rowオブジェクト,Columnオブジェクト内にはCellsコレクションがあるので,そこを利用すれば強引にFor Eachが使えます。
二回 For Eachを使えば表全体を扱えるということですね。

    Dim i As Long, tmp As String
    For i = 0 To DataCollection.Count - 1
        tmp = DataCollection(i + 1)
        PasteTable.Cell(Int(i / 5) + 1, i Mod 5 + 1).Shape.TextFrame.TextRange.Text = tmp
    Next
    
    For i = 0 To DataCollection.Count - 1
        tmp = DataCollection(i + 1)
        PasteTable2.Cell(Int(i / 3) + 1, i Mod 3 + 1).Shape.TextFrame.TextRange.Text = tmp
    Next

それぞれの表に流し込んでいます。
表のセルは (1,1) ~ なので, 0を利用していることから1を足して利用しています。
Int(i/5)で 5で割った商 , i mod 5 で5で割った余り という意味です。

ちなみに表の各セルのテキストは
Cell(行,列).Shape.TextFrame.TextRange.Text
と階層が深いのはパワポVBAの仕様なのであきらめるしかありません。。

以上でした(ΦωΦ)

再利用可能な自分用ライブラリを作るために(自分ルール)

VBA

VBAでささっと自分で作った部品を読み込ませて使えると,プログラミングできる人がほとんどいない職場ではなんとなく仕事ができる雰囲気になるので,それを実現してみたい。

まとまらないものは,ブログに書きなぐって載せて置いたら検索でちょっと調整して使える。

成熟したものは,テキストファイルでいつも読み取れるものに入れておけば,再利用できるようになる。

なんとか目指したい。


クラスモジュールはカプセル化すれば外部に無用な影響は及ぼしにくいでしょうから楽ですね。

でも,クラスモジュールは便利で楽しいですが,なんでもかんでもクラスモジュールにするのは仰々しい。


問題は標準モジュールの使いまわしか。

標準モジュールでちゃちゃっとすませたいこととかありますしね。テンプレート的な標準モジュールを部品として用意しておいて,それを直接編集できるように考えるのもいい。



そのあたりを考えると,一番気になるのは変数のかぶり。

プライベート変数とスコープが広い変数がかぶると具合がわるいです。


普段はカウンタの変数もi,j,k,・・・でいいですが,繰り返し使うやつには少し配慮したいものです。

基本的に私はスネーク記法というのを自然には用いないので,逆にテンプレート的なものにはスネーク記法で書いておけば被らなくなるのかな。

パスカル記法 … UserNameのように単語の先頭を大文字にする
キャメル記法 … userNameのように最初の単語だけ先頭小文字で2つ目以降の単語は先頭を大文字にする
スネーク記法 … user_nameのように小文字の単語をアンダーバーで区切る
大文字記法 … USER_NAMEのように大文字の単語をアンダーバーで区切る

t-homさんのVBA コーディングガイドライン より引用

自分ルールでは,

使いまわす標準モジュールの変数はスネーク記法!

というのを守って,標準モジュールはbasファイル,クラスモジュールはclsファイルで保存していつも持ち歩くようにすればなんとなくやれそうですね。

OneDriveが使える環境でなら,そこに貯めておけば便利だな。職場では使えないんだよなぁ。セキュリティ上しかた無いけど残念です。

OneDriveが使えないところではどうするかはまた考えるとして,とりあえずスタートを切って修正していけばいいですね。

そろそろ,スマートにコードの再利用ができる人になりたい。

見つからないからささっと作ってしまえ,というのも楽しくていいんですが,効率も目指さないとですね・・(ΦωΦ)

今年度はこの方向性で,パワーポイントのVBAも書き直したり再調整したりしつつ,ブログも書いていきたい。

教材にはパワーポイントVBA,校務にはエクセルVBA,ワードVBAがとても便利なことが多いので,やっぱ3つともやっていくことになりそうですね。

勇者ヨシヒコの メレブさんの

 「おれは、この呪文に*** と名付けたよ」

というのを想像しながら,モジュールに名前をつけつつライブラリをためていきたいものです。

勇者ヨシヒコまた見たいなぁ( ´ー`)

(ΦωΦ)

雑記

やっと,Huluを見ながら仕事ができる余裕が出てきました。

Hulu見ながらでも,自宅で仕事をしている時点でどうかと言われそうですが,

仕事と趣味の境界が私には無いようです。

教材を作ることも純粋に楽しく,それで少しでも授業が改善されればなおのこと。

時間割を作るのは今年はかなり厳しく,これにはストレス半端ありませんでしたが,

ようやく折り合いがつきそうになり,少し余裕が出てきました。

Webシステムで全国の教育情報システムが作られることが多いようですね。

Webへの入力はあまり便利にはなっていませんので,データ取り込みの仕組みがだいたいあることが多いです。

やはりExcelは万能で,そのようなときにとても便利に動いてくれます。

データの入力規則を使えばパソコンが苦手な人にも比較的利用しやすいユーザーインターフェイスを提供できますので極めて便利ですし,

データ入力規則に適合するテキストデータを効率的に用意できれば,直接Webを操作しなくても望みのことを楽にできます。


今回の時間割の場合は

  時間割作成ソフトで作成(ミスの確認のためにも便利です)
    ↓
  CSV形式テキストでExcelに。
    ↓
  Excel上で職場の先生や生徒への連絡の作成 様々な形式を日々作るのでマクロが無いとけっこう面倒(;´▽`A``
    ↓
  このデータをWeb取り込み用に変換

VBAできちんと作れば,ミスの段階を限定できるので,かなり確認の段階を減らせて,だいぶ時間と手間の軽減ができそうです。

これを手作業でしないといけないならほんと,気が滅入ります。。自分用とはいえVBAは役に立ちますね。

複雑なものは組めなくてもいいけど,ある程度VBAが使えるように皆がなればずいぶん働き方が変わるんだろうなぁと思わざるを得ません。


同じ規則で並び替えれば,若干の相違が含まれていても変換テーブルを作るのが比較的容易なので,ソートもミスの減少,手作業の補助として有効です。

今回は取り込みながら並び替えるという方法をコードにしてみながら遊んでいましたが,

前使ってたコレクションのソート機能をインポートすればいいだけの話でした。


組んでみたいという気持ちがあり,楽しみの意味で組むことに問題は無いんですが,どうしてもコードの再利用がうまくできていないことは以前からの悩みです。

家で仕事できるときは,自分のブログを検索して再利用することはできますが,職場ではネットを見れません。

どうやったらいいんでしょうね。今はがっつりコード組むのにはまれていた時の分をもうけっこう忘れていることがよくわかりました。

同じようなコードで重なったとしてもまた頭の中作り直していかないといけないですね。自分の記憶力の無さには敬服します(;´▽`A``ヒドスギル。

コードのエクスポートはできるわけですし,basファイルをうまく管理できる仕組みを作らないといけないかなぁ。

これだけ忘れるのが早いと,記憶,能力を身に着けるより,外部記憶手段を用意しないて管理する手段を準備しないと先に進めない。。

教材の準備のほうに移行できそうな気がしてきたので,Powerpointのコード遊びにも戻れる気がしています。

コード管理どうやったらいけるかなぁ。。(;´▽`A``

あれれ(;´▽`A``

VBA

VBAでいろんな作業をしつつ,データ処理ばっかりやっているので,ほんとここには何も書けていないんですが,

以前から不思議なことが1点と,今回うまくいかなくて困っていることが1点。

不思議なことは,Collectionを使っているとき,突然強制終了をすること。

まぁまぁ頻繁にです。

下記のコードでもよく強制終了される。

せめてエラーを吐いて怒るくらいにしてほしいのにな。

でも,Excelを起動しなおすと,普通にコードは動いてしまい,どこかおかしいわけではないようなんです。

頻繁に強制終了されるのは けっこうストレス(; ・`д・´)



うまくいかなかったものは自己解決しました。

ソートを書くのが大変なので,入れなおす時に評価しながら入れて終わらせてしまおうという考え方をしました。

入れ替えを頻繁にしないでいいので,シンプルだし,人の感覚で並び替えるのってこんなかんじだなぁと思いながら作りました。

Sub ソース科目取得()
    Dim dic As Scripting.Dictionary
    Dim i As Long, j As Long, k As Long, l As Long
    Dim SourceSht As Worksheet: Set SourceSht = ThisWorkbook.Worksheets("ソース")
    Dim arr科目 As String, 時間割行番号 As Long
    Dim tmp科目クラス As String
    Dim col As Collection, flg As Boolean
    i = 2
    Do
        時間割行番号 = Me.Cells(i, 1)
        Set dic = New Dictionary
        Set col = New Collection
        arr科目 = ""
        
        For j = 4 To 33
            tmp科目クラス = SourceSht.Cells(時間割行番号, j) & SourceSht.Cells(時間割行番号 + 1, j)
            If tmp科目クラス <> "" And tmp科目クラス <> "※※" Then dic(tmp科目クラス) = 1
        Next
        l = 1
        For j = 0 To dic.Count - 1
            tmp科目クラス = dic.Keys(j)
            flg = False
            If l = 1 Then
                col.Add tmp科目クラス
                flg = True
            Else
                For k = 1 To col.Count
                    If tmp科目クラス < col(k) Then
                        col.Add tmp科目クラス, before:=k
                        flg = True
                        Exit For
                    End If
                Next
            End If
            If flg = False Then col.Add tmp科目クラス
            l = l + 1
        Next
        Stop
        For j = 1 To col.Count
            arr科目 = arr科目 & "■" & col(j)
        Next
        Me.Cells(i, 4) = Mid(arr科目, 2)
        i = i + 1
    Loop Until Me.Cells(i, 1) = ""
End Sub

f:id:chemiphys:20170408024932p:plain