役に立つか?VBAメモ

仕事で使ったVBAをメモっとく

Office2016をインストールしてみた

Windows Insider Programからこんなメールが来てた。

・・・・Windows Insider の皆様は、Windows 10 で Office 2016 のプレビュー版をご利用いただけるようになりました。Office 2016 のプレビュー版には新機能が搭載されており、2015 年の後半に Office ユーザーへの配信を予定しています。 Windows Insider の皆様には、早期にフィードバックをお寄せいただきたいと考えております。 ぜひ今すぐ Office 2016 Preview をダウンロードして、ご利用ください。

 

なので、早速サイトに行ってダウンロードしました。

f:id:jus7733:20150708164551j:plain

インストール!

f:id:jus7733:20150708164615j:plain

途中で開けるようでしたが、待ちました。

f:id:jus7733:20150708164647j:plain

終わったようなので、Excelを開いてみました。

Microsoftのアカウントでアクティベート出来そうで、出来ないようです。

サイトに書いてあるプロダクトキーを入力することでアクティブ化出来ました。

f:id:jus7733:20150708164955j:plain

若干のUI変更ぐらいで2013と大差変わりません。

赤で囲んだ部分に親切?な検索項目が出来てますね。

VBEもちょっと見ただけですけど変わってないようです。

実際には何もやってないので、詳しくは分かりませんがタダなのでwどうでしょうか?

 

 

Outlook予定表作成をExcelのVBAで行う

リクエスト頂きましたので書いていきます。
だいぶ前に作ったものなので、詳細などは忘れている部分もあり、
また、訳もわからずに使っているコードもあります^^;
なので細かい質問などに答えられる自信は無いことを宣言しておきます(滝汗)。

申し訳ないことにコードは一部丸々コピーしているものも有ります。出典は以下です。
三流君VBAでOutlookを操作する
Outlook 研究所 | Outlook を徹底活用する方法を研究するサイトです。

 


予定表作成のブックは2つのシートがあります。
①Sheet1に実際の予定を作成する表とコントロールを配置しています。
 VBAコードもSheet1に書いてます。
②Sheet2に表に入力規則から入力する既定の各リストを羅列しています。
 ただリストを使わなきゃ要りませんし、Sheet1の端っこに記入してもいいです。
 
Sheet1の記入
 各コントロールを適当に配置します。

f:id:jus7733:20150527162524j:plain


 MonthView Control                                        日付の入力に使います
 CommandButton1(入力のクリア)                  クリアに使います
 CommandButton2(保存しないで閉じる)       ブックを閉じます
 CommandButton3(予定作成!)                     予定表作成を実行します
 
 表は図のように作成します。

f:id:jus7733:20150527162544j:plain


 L列には「=IF(K14="◯",TRUE,FALSE)」
 O列には「=IF(N14="◯",TRUE,FALSE)」と関数を入れた後、目障りなので非表示にしときます。
 なおKとL列には入力規則で”○”をリストにしておきます。


 一応、一度に10件までは予定を立案できるようにしてあります。
 分類項目等をドロップダウンリストから選択するようにするならば、該当セルに設定しておいてください。
 分類項目を使いたい場合は、先にOutlookの分類項目を作成しておかなくてはイケマセンよ~
 
MonthView Controlを配置(無くてもいいです)
  MonthViewのコード(カレンダークリックで日付入力)
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Dim Ni As Long
Ni = Range("B" & Rows.Count).End(xlUp).Row
Range("B" & Ni + 1).Value = MonthView1.Value
End Sub

 

CommandButton1のコード
 10件を超えて連続して予定を入れていきたい際には一発クリアで便利。
 項目が増えることも考えて、余計な書き方になっています。
Private Sub CommandButton1_Click()
Dim R1 As Range
Set R1 = Range("B14:K23,M14:M23,N14:N23,P14:P23")
R1.Value = ClearContents
End Sub

 

CommandButton2のコード
 保存せずに閉じるだけのコード
Private Sub CommandButton2_Click()
Application.DisplayAlerts = False
ThisWorkbook.Close
End Sub

 

CommandButton3のコード
 いよいよOutlook予定表を作成します。
'//
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub CommandButton3_Click()
'outlook用宣言
Dim oApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim objITEM As Object
Dim objWShell As Object
Dim flg As Boolean
Dim hwnd As Long
Dim i As Integer
Dim jDAte As Date
Dim jTime As String
Dim jCate As String
Dim jLon As Integer
Dim jSub As String
Dim jBdy As String
Dim jRem As Boolean
Dim jRet As Integer
Dim jAll As Boolean
Dim jBusy As Integer
'クラス名
Const FCLASSNAME As String = "rctrl_renwnd32"

'Outlook 起動
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application") '既に起動している場合に取得
If Err.Number <> 0 Then
Set oApp = CreateObject("Outlook.Application")
flg = True
End If

On Error GoTo 0

'予定表各項目
For i = 14 To 23 '予定表内容のセル番号を指定
jDAte = Range("B" & i) '予定日
jTime = Range("C" & i) '予定時刻
jCate = Range("E" & i) '分類項目
jLon = Range("D" & i) '時間
jSub = Range("F" & i) '件名
jBdy = Range("G" & i) '本文
jRem = Range("L" & i) 'リマインダー
jRet = Range("M" & i) '通知時間
jAll = Range("O" & i) '終日指定
jBusy = Range("P" & i) '公開方法


If Range("B" & i) = "" Then Exit For '空白だったらループ脱出

If flg Then
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(9) '起動時フォルダーを指定
myFolder.Display
Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
objITEM.Display '編集画面を表示

Else
Set objWShell = CreateObject("WScript.Shell")
objWShell.AppActivate oApp.ActiveWindow.Caption 'アクティブ化
hwnd = FindWindow(FCLASSNAME, vbNullString)
SetForegroundWindow hwnd '前面に持ってきて
objWShell.SendKeys "%R" '元に戻す
Set objWShell = Nothing 'ここで終わった後に、
Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
objITEM.Display '編集画面を表示

End If

'予定表内容詳細
objITEM.Subject = jSub '件名をセット
objITEM.body = jBdy '本文をセット
objITEM.Duration = jLon '時間(分単位)でセット
objITEM.Start = DateValue(Format(jDAte)) & " " & jTime '予定日と開始時刻をセット 時刻のスペースはOutlookで必須のよう
objITEM.AllDayEvent = jAll '終日指定するか?
objITEM.ReminderSet = jRem 'リマインダーセット(←はfalseの場合しない)
objITEM.ReminderMinutesBeforeStart = jRet 'リマインダー(開始何分前にアラームを出すか?)
objITEM.Categories = jCate '分類項目をセット
objITEM.BusyStatus = jBusy '公開方法をセット0~4
objITEM.Save '保存して
objITEM.Close 2 '閉じる

Next i '次のセルの日付へ

Set oApp = Nothing 'ループ脱出してもOutlookは何もしない

End Sub

 予定表に追加したい項目があるのならば、ここを参照して追加してください。

 なお、公開方法の内容は下記。
 0空き時間
 1仮の予定
 2取り込み中
 3外出中
 4他の場所での作業


Outlook予定表作成の流れ
1.予定日のカレンダー日付をクリックする
2.開始時刻入力(ex.8時30分→8:30)
3.時間を入力。「分」単位で入力する
4.分類項目(DDリストから)選択または無指定
5.件名を(DDリストから)選択または自由入力
6.本文を(DDリストから)選択または自由入力
7.通知設定の有無をDDリストから選ぶ ○で有り
8.通知時間セット 分単位で
9.終日指定をDDリストからセット ○で有り
10.公開方法0~4 セット空欄は空き時間

f:id:jus7733:20150527163941j:plain


11.「予定作成!」ボタンをクリック→Outlook起動、予定立案
12.「入力のクリア」をクリックして、続いて予定表作成するか
「保存しないで閉じる」をクリックして終了

 

あれ~分かりやすい説明に成った?上手く出来なかったかもしれません(TдT)
わからなかったらコメントしてください。すみません・・・書き方下手になったなぁ~
Office2007で作成して、10でも13でも使えてますので問題は無いかと思います・・・・

 

 

 

別のブックを開いてコピーする

ブック間でコピーするのは決まったところに決まったものを貼り付けるとなると一々が面倒です。
開いてコピーして、ペーストするブックをアクティブにして貼り付けて、コピー元閉じて・・・
といっても複数のブックから集計することはママあります。
手っ取り早くVBAでやっちゃいましょう。

 

 

Private Sub CommandButton1_Click()
Dim flag As Boolean
Dim Fdir As String
Dim FPss As String
Dim FileName As String
Dim Opnbook As Workbook
Dim Z As Worksheet
Dim H As Worksheet

'チラついて五月蝿いのを防止
Application.ScreenUpdating = False

Fdir = "C:\Users\ユーザ名\Documents\フォルダ名\"
FPss = Fdir & "開くブック.xlsx"
FileName = FPss

flag = False

'今開いているブックを調べる
For Each Opnbook In Workbooks
If Opnbook.FullName = FileName Then
flag = True
Exit For
End If
Next Opnbook

'目的のブックが開いてなければ開き、名前をセット
If flag = False Then
Set Opnbook = Workbooks.Open(FileName)
End If

'コピー元先のシートをセット
Set Z = Opnbook.Worksheets("sheet1")
Set H = Workbooks("アクティブブック.xlsm").Worksheets("sheet1")

'コピー元をアクティブにする
Opnbook.Activate

'コピペ 今回コピー元セルには計算があると仮定して、値で貼付けとしている
'2箇所コピペすることにしてある
Z.Range("A1:A10").Copy
H.Range("A5").PasteSpecial Paste:=xlValues

Z.Range("A11:A20").Copy
H.Range("B5").PasteSpecial Paste:=xlValues

'コピー元にもよるけど保存するか否かのダイアログがでたりするのでそれは表示させないで閉じる
Application.DisplayAlerts = False
Opnbook.Close

'主たるブックをアクティブにする
Workbooks("アクティブブック.xlsm").Activate
H.Range("A1").Select

End Sub

 

 

 

 

"開くブック.xlsx"をアクティブブックのセル内でリスト化して代入させると複数のコピー元ブックを必要に応じて開くこともできるでしょう。(リスト=ブック1、ブック2、ブック3・・・とか)
その時には貼り付け先も考えてね。上書きされちゃうから。

あと画面の更新時のチラツキは邪魔なんで、”Application.ScreenUpdating = False”と書きました。
チラツキ防止には色々あるようだけど1行で済むので・・・
チラツキはメモリ消費もかなりあるようで、場合によっては、Excelが落ちる原因になってる場合もあります。
別のブックではこの1行で落ちなくなったので、一応は実績有りです。

 

 コレジャナイ

ビッグデータのマップ風をエクセルで作る

暇だったんで遊んでみたw
Excel2013が必要ですが、”Office 2013 Professional Plus”か”Office 365 ProPlus”、
若しくはExcel 2013単体バージョンが無くては使えません。
自分は”Office 2013 Professional”環境です。Pulsついてませんけどいいんでしょうか?

Microsoft Power Query for Excel は、データの検出、アクセスおよびコラボレーションを簡略化することで、Excel のセルフサービス ビジネス インテリジェンス環境を拡張する Excel アドインです。

ってことなので、Microsoft Power Query for Excelをまずインストールします。

Download Microsoft Power Query for Excel from Official Microsoft Download Center

次に今回の本丸Power Map for Excelをダウンロードして、インストールします。


Power Map for Excel

インストール時にVisual C++ 2013 Runtime Libraries(x86)が無いとインストールするように促されます。

f:id:jus7733:20150306163018j:plain

f:id:jus7733:20150306162919j:plain

I agreeとNextとCloseだけですので英語でも怖くありません。

双方ともインストール後にはExcelアドインとして有効になっているとは思いますが、もしなっていないようなら
COMアドインを開いて有効にチェク入れましょう。

地震マップを作りたいと思ったんで、Hi-Net(http://www.hinet.bosai.go.jp/)からHi-net自動処理震源リストを拾ってこようと

Power Query のWebから取得にURLいれて、試みる・・・・も失敗。
Power Query ではログイン認証の壁を超えることは出来ないようなのであった(´・ω・`)ガッカリ…
Yahoo!からはデータとれたけどあまりにもしょぼかったので以下Power Queryは割愛。
そんなに難しくは無いんで弄ってみてください。気象庁の降水量とか環境省の花粉量とかPM2.5とかいいんじゃないかな?

さて、Hi-Netの方のデータは仕方ないので、ページのデータをコピペしてセルに貼り付けてみた。

f:id:jus7733:20150306163202j:plain

横一行一文のテキストデータだったので、Value関数とMID関数で各データを振り分けました。これで準備は整いました。

f:id:jus7733:20150306163224j:plain

データの入ったセルを選択した状態で、[挿入]-[Power Map]をクリックします。

じゃ~ん!地図が出てきたぞ!!!

f:id:jus7733:20150306163247j:plain

というか、これアドインのレベルじゃね~Excelでもな~~~いw
などと若干のワクワク感を抱きつつ、次のステップへ。

Hi-Netでは、地図の位置データは緯度経度なので、それをチェックします。
もし、元データが住所等でしたらそれを選べばいいです。

[次へ]

f:id:jus7733:20150306163338j:plain

値はM(マグニチュード)を選び集約なしに。

f:id:jus7733:20150306163414j:plain


時間は時間(なし)にして、右上にちっさくある時計をクリックして「データが少しの間表示されます」を選択します。

f:id:jus7733:20150306163452j:plain

歯車アイコンはオプション設定です。レイヤーオプションの影響範囲を200%、シーンオプションのシーンの長さを15秒にしました。

再生ボタンをポチリ。

でけた~テーマをエアリアルカラーにもした!
しかもツアーのところにある「ビデオの作成」を押してみると・・・

MP4で動画になったぁぁ


地震 - YouTube

 

結構簡単にできるものです。
色んなデータで遊んでみるのも面白いかもね。

入力時の自動スクロール

大量のデータを打ち込んでいて、ウィンドウの一番下まで行ってしまうとかなり見難くなりません?

私はなります。

どうせなら、入力セルは見やすい位置にずっていてくれたほうが助かります。

なので、自動でスクロールして選択セルは定位置にするマクロが必要です。

 

WorksheetのSelectionChangeイベントに書いていきます。

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Scrl As Long
Dim i As Long

Application.ScreenUpdating = False 'スクロールの際のチラツキ?防止の為

For i = 0 To 94 '100行目まで

Scrl = 6 + i

If Target.Row > Scrl Then '6行目を超えたら

ActiveWindow.ScrollRow = Scrl - 5 '1行スクロール=定位置

End If
Next i

End Sub

 

これだけだとあまり役に立たないので、他のマクロと組み合わせます。

まあ、こんな感じ。

bat de 楽する 朝から自堕落ファイル

朝の事務所でのラジオ体操は、俺のPCから流します。

スピーカーの音量上げる→ラジオ体操.mp3をクリック→体操する

終わったら、スピーカーの音量とメディアプレイヤーを落とす。

たったこれだけですけど、音量の上げ下げを忘れたりといちいちが面倒。

怠け者過ぎますけどね。

なんで、batファイル書いとくことにしました。

VBAじゃないけど、メモっとくことにします。

 

用意するもの
・mcvc400.exe
・音源(ラジオ体操全205秒)
・メディアプレイヤー(今回はwindows付属のプレーヤー)

 

準備
mcvc400はここからダウンロードして、好きなところに解凍して置いてください。


MOS PrivateProduct コンテンツ


取り敢えずDドライブ直下にフォルダ名”mcvc400”として置いておきました。
mcvcの設定方法はmcvcに同梱のテキストを読んで下さい。

音源はmp3など再生可能なもので、ファイルパスとその音源の長さ(秒数)をメモしておいてください。

メディアプレイヤーはなんでもいいのですが、音源再生のデフォルトメディアプレイヤーにしてください。
実行ファイル名をメモしておくのも忘れずに。

 

作成
メモ帳を開いて書いていきます。


  @echo off
  流れを見たいならonで。
 
  cd /d D:\mcvc400
   /d 付けないとディレクトリ変わってくんないのね。Linuxのコマンドとちょっと違うんだね。
 
  mcvc.exe m80+
   音量80%ミュートオフにしました。
   
  start C:\Users\”ログインユーザ名”\Desktop\radio.mp3
   デスクトップ上のradio.mp3を再生します。
   パスにスペースが含まれる場合は""で囲むの忘れずに!
   
  timeout /t 205 /nobreak
   timeoutを使います。
   コマンドプロンプトでtimeout /?を打てば説明が出てきます。
   タイムアウト時間(=再生時間は205秒)でキーが押されても無視設定です。
   
再生が終わったあとの処理
  taskkill /f /im wmplayer.exe
   メディアプレイヤーを強制終了させます。

  https://technet.microsoft.com/ja-jp/library/cc725602
   
  cd /d D:\mcvc400
   また戻って
   
  mcvc.exe m-
   ミュートします。例えば10%音量にするならm10ね。
   
  最終行でEnterして1行下にすること。
 
@echo off
cd /d D:\mcvc400
mcvc.exe m80+
start C:\Users\hoge\Desktop\radio.mp3
timeout /t 205 /nobreak
taskkill /f /im wmplayer.exe
cd /d D:\mcvc400
mcvc.exe m-

1クリックで朝のお努め終わります。ものぐさにには格好です。
タスクスケジュール化できれば何もしなくても済むんですけど、体操は定時じゃないんでそれは出来なかった。
今どき流行らないでしょうが目覚まし時計とかにはいいんじゃないの?

 

DVD付き もっとスゴイ! 大人のラジオ体操 決定版 (講談社の実用BOOK)

DVD付き もっとスゴイ! 大人のラジオ体操 決定版 (講談社の実用BOOK)

 

 

 

自作アドインで楽々

便利なVBAはそれぞれのBOOKにコピペして使っていたが、いちいち面倒なのでアドイン化して
右クリックメニューに追加してみました。環境はExcel2013だけどそれ以前でも大丈夫だと思う。

エクセルを起動させ、ファイル-オプション-セキュリティーセンター-セキュリティーセンターの設定から
信頼できる場所に”C:\Users\hoge\AppData\Roaming\Microsoft\AddIns”を追加しておく。
但し、これを設定すると今後外部のアドインを拾ってきた場合も全て有効になるので注意が必要。
心配なら個別に設定したほうが無難なんじゃないかな。

新規ファイルを開きVBEを起動したら、下記を書いていきます。

ThisWorkBookに記入するWorkbook_Openイベントです。
余分に5件も動作をいれてしまった・・・
--------------------------------------------------------------
Private Sub Workbook_Open()
Dim cmdBr As CommandBar
Dim RcMenu0 As CommandBarButton
Dim RcMenu1 As CommandBarButton
Dim RcMenu2 As CommandBarButton
Dim RcMenu3 As CommandBarButton
Dim RcMenu4 As CommandBarButton

'通常と改ページ表示とも「Cell」名を使っているので双方でコマンドを表示するために実行
For Each cmdBr In Application.CommandBars
If cmdBr.BuiltIn Then 'Excel既定の参照かどうかを判断。規定値はtrue
If cmdBr.Name = "Cell" Then

'Object.Add(Type, Id, Parameter, Before, Temporary)
'Type=msoControlButton、定数は1、記述方法は下記いずれもOK
Set RcMenu0 = cmdBr.Controls.Add(Type:=msoControlButton, Temporary:=True)
Set RcMenu1 = cmdBr.Controls.Add(msoControlButton, , , , True)
Set RcMenu2 = cmdBr.Controls.Add(Type:=1, Temporary:=True)
Set RcMenu3 = cmdBr.Controls.Add(1, Temporary:=True)
Set RcMenu4 = cmdBr.Controls.Add(1, , , , True)

With RcMenu0
.BeginGroup = True 'グループ化する
.OnAction = "EXTex" '動作
.Caption = "Excel終了" '表記
End With

With RcMenu1
.OnAction = "SAVEEND"
.Caption = "保存後終了"
End With

With RcMenu2
.OnAction = "ENDBK"
.Caption = "終了"
End With

With RcMenu3
.BeginGroup = True
.OnAction = "Print860"
.Caption = "№860印刷"
End With

With RcMenu4
.OnAction = "Print2800"
.Caption = "№2800印刷"
End With

End If
End If

Next


End Sub
--------------------------------------------------------------
次に標準モジュールに記入します。
今回は、自分がよく使う5件を記入した。
Excelを有無を言わさず閉じる(保存もしない)
・アクティブなBOOKを保存してから閉じる
・アクティブなBOOKを有無を言わさず閉じる
・860番と名前のついたプリンタでクイック印刷
・2800番と名前のついたプリンタでクイック印刷
--------------------------------------------------------------
Option Explicit
'Excel閉じる
Public Sub EXTex() 
Application.DisplayAlerts = False
Application.Quit

End Sub
--------------------------------------------------------------
'保存後閉じる
Public Sub SAVEEND()
On Error Resume Next
ActiveWorkbook.SAVE
Application.DisplayAlerts = False

ActiveWorkbook.Close

Exit Sub

End Sub
--------------------------------------------------------------
'BOOKの強制終了
Public Sub ENDBK()
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Close

Exit Sub

End Sub
--------------------------------------------------------------
'№860プリンタで印刷
Public Sub Print860()
On Error GoTo Errmsg
ActiveSheet.PrintOut _
Copies:=1, _
ActivePrinter:="Printers №860", _
Collate:=True
Exit Sub

Errmsg:
MsgBox "印刷するものがありません"


End Sub
--------------------------------------------------------------
'№2800プリンタで印刷
Public Sub Print2800()
On Error GoTo Errmsg

ActiveSheet.PrintOut _
Copies:=1, _
ActivePrinter:="Printers №2800", _
Collate:=True
Exit Sub

Errmsg:
MsgBox "印刷するものがありません"

End Sub

 

全て記入が終わったら、名前をつけて拡張子をアドインの「.xla」か「.xlam」にして先のユーザーアドインフォルダに保存します。
Excelを再起動すると右クリックのメニューに先ほど設定したマクロがオプション-アドイン-Excelアドインに登録されています。
有効なアドインにチェックを入れると使えるようになります。(再度Excel再起動必要?)

アドインは再度書き直そうとしても直接は開けないですが、新規BOOKを開いてみるとVBEに出てきます(<自環境では)ので再編集は可能です。

ほぼ自分用メモなので読みづらかったらゴメンナサイ。
OfficeTabを使っていと閉じる操作の度に購入を促すダイアログが出て煩わしく、そのため終了系をメインで登録してあります。

※プリンタ名は別のWin32 API関数VBAまんま拾ってきて(http://www.geocities.co.jp/Technopolis/2082/Soft/Excel/Excel_b3.htm)、取得しました。怖いんで弄くれませんw