役に立つか?VBAメモ

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

IME切り替えがめんどくさい

表を作っていると、どうしても日本語での入力と英数字での入力が混在しますね。

通常は都度半角/全角キー押したり、変換・無変換キーを押すことで日本語/英数字切り替えていることでしょう。

 

 

めんどうじゃない?

私は面倒です。

ちょっとだけだったら我慢しますよ?

でも毎日毎回だと・・・・

 

そんなお悩みのご貴兄に朗報です。

 

例えば下の表1の様な帳票などあったりします。

f:id:jus7733:20190117104645j:plain

表1

A/C/H各列が日本語での入力となっており、ほかは英数字又は計算式です。

この場合、5~6回は切り替えキーを押さなければなりません。

押し忘れて勢いでインプット続けると残念な結果も。

 

そこで、こちらを。

Option Explicit

Sub 日本語入力()
With Sheets("sheet1").Range("A3:A12,C3:C12,H3:H12").Validation

.Delete '入力規則を削除

.Add Type:=xlValidateInputOnly 'IME入力の設定だけ

.IMEMode = xlIMEModeOn 'IMEオン(日本語入力)
End With
End Sub

 

これだけです。

 

細かいことは下記読んでおくれ。

docs.microsoft.com

 

 かきもよろしく。

Sendkyesが使えないんだ!

なんかいろいろあって使えないらしい。

とは言え、使いたい。

グーグル先生、おしえて!

デデデン♪

AZ_Mouse's HP♪さんの小技集から

http://www.geocities.co.jp/SiliconValley-PaloAlto/9180/exsendkeys.html

最終更新日2000年だって!動作確認もWin95/WinNT/AC97ですよ。

でも大丈夫、win10+office2013で動いてるし。

2013言ってる時点で古いしw

 

細かな説明は引用元様を御覧ください。

 

Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

Public Sub gSub_ExSendKeys(uKeyCode_1 As Integer, Optional uKeyCode_2 As Variant)


If IsMissing(uKeyCode_2) Then

Call keybd_event(CByte(uKeyCode_1), 0, 0, 0)

Call keybd_event(CByte(uKeyCode_1), 0, 2, 0)
Else


Call keybd_event(CByte(uKeyCode_1), 0, 0, 0)

Call keybd_event(CByte(uKeyCode_2), 0, 0, 0)

Call keybd_event(CByte(uKeyCode_2), 0, 2, 0)

Call keybd_event(CByte(uKeyCode_1), 0, 2, 0)
End If

End Sub

 APIはさっぱりなので、書いてあるまま使います。

聞かないでください。

 

 

Outlookの仕訳ルールの実行をするにあたり、手動で一々実行するのが面倒なので、下記を作成しクイックアクセスツールバーに登録しました。

 

Sub 仕分け()

Call gSub_ExSendKeys(vbKeyMenu)
Call gSub_ExSendKeys(vbKeyControl, vbKeyO)
Call gSub_ExSendKeys(vbKeyR)
Call gSub_ExSendKeys(vbKeyR)
Call gSub_ExSendKeys(vbKeyMenu, vbKeyE)
Call gSub_ExSendKeys(vbKeyMenu, vbKeyO)

End Sub

 

フォルダーー仕訳ルールの実行ールール全選択ー実行 です。

閉じるまでやりたかったけどうまくいかなかったのはご愛嬌。

KyeCode定数は、マイクロソフトこちらを参照してください。

 

ExcelでUserFormのTextBoxのカーソルを右に動かしたかったので、探して見たのが最初でした。

キーコードが使えると捗るよ!

 

 

 

 

 

 

 

自動で名前の付いたシートを作成する

先日、新規ブックを作成するにあたり、シートを16コ作らねばなりませんでした。
Sheet1の横にある【+】をポチポチクリックすればシート”だけ”は出来ますよ。
sheet2、sheet3、sheet4・・・・・sheet16ってね。
これをまた一つ一つシート名を変えていくのは面倒、と言うより辛い。
でも変えないと後々もっと面倒なことになることは分かってます。

そこでググってみよう!先駆者の知見を掠め取って、学んで見よう!

 

 

その1
VBAでシートを追加して、ついでに名前もリストから付けていってしまおうヽ(=´▽`=)ノ

①ブック作成
②sheet1の名前は取り敢えず【list】と名付けよう
③セルA1から順にA5までシートにつける名前を1セルにつき1つ記入しよう
④VBEで下記マクロ作成

Sub シート作成()
Dim SheetName As Range
For Each SheetName In Selection
Sheets.Add After:=Sheets("list")
ActiveSheet.Name = SheetName.Value
Next SheetName
End Sub

⑤マクロ実行

 

f:id:jus7733:20170112101538j:plain

このような感じでできあがりました。

でもなんか逆順(降順)じゃない?

これでも構わないのですが、ちょっと気持ち悪い。

 

 

その2
その1ではリストに対してシートが左から製品(n>4>3>2>1)ってなっててちょっとやだ(´・ω・`)
それなので単純に逆順でやればいい。

①ブック作成
②sheet1の名前は取り敢えず【list】と名付けよう
③セルA1から順にA5までシートにつける名前を1セルにつき1つ記入しよう
④VBEで下記マクロ作成

Sub シート作成2()
Dim SheetName As Range
Dim n As Long
n = 5
For Each SheetName In Sheets("list").Range("A1:A5")
Sheets.Add After:=Sheets("list")
ActiveSheet.Name = Sheets("list").Range("A" & n).Value
n = n - 1
Next SheetName
End Sub

⑤マクロ実行

 

f:id:jus7733:20170112101757j:plain

セルA1からの順送りではなくA5から遡っているだけ。
ただそれだけ。

左から昇順なので気分いい?

 

 

折角なので・・・


リストからシートを作成したので次はシート名を取得してリスト化するやつ。

①シート名を取得したいブックを開く
②シート【list】を追加作成
③下記マクロ作成

Sub シート名取得()
Dim SheetName As Object
Dim n As Long
n = 1
For Each SheetName In Sheets
Sheets("list").Range("A" & n).Value = SheetName.Name
n = n + 1
Next
End Sub

④マクロ実行
⑤シート【list】A1~にシート名一覧ができている、でしょ?

 

f:id:jus7733:20170112102006j:plain

 

単純なマクロですが、作業効率的には面倒さ加減が大分減るので良い!と思います。

大したことないと云えば、大したことないですがね。

 

 

一発範囲指定すりゃ、楽でしょう?

印刷範囲の設定をするときは、一般的に、
 範囲を指定して→ページレイアウトタブ→印刷範囲設定
やりますね。

ページごとに印刷するなら、
 ファイル→印刷→ページ指定
って具合かな?

 

仕事でこれやる時ってまず表なりが定型で作ってあって、値入れれば出来上がり、という場面が多いと思います、多分

1シート内でページごと、範囲ごとに異なる品種なり顧客なりの表など作ってあるのもよく見ます。

その度、必要なページだけ印刷するのに、冒頭のやり方をしているのが普通かな?

まあ違う方もいっぱいいるでしょうが。

 

兎に角、こんな方法はポチポチクリック回数ばかり多くて面倒です。
なので、シートの上部に(いやどこでもいいけど)ボタンを配置して、ボタンを押せば範囲指定をするようにします。

範囲の指定は【PageSetup.PrintArea】で行います。


例)ActiveSheet.PageSetup.PrintArea = "$A$1:$D$10"

セルA1からD10を範囲指定してます。
「""」のプロパティ値を長さ0("")にするとシート全体を指定することとなり、範囲指定が解除されます。


Private Sub CommandButton1_Click()

ActiveSheet.PageSetup.PrintArea = "$A$1:$D$10"

With Sheets("sheet2")
.Select
.PageSetup.PrintArea = "$A$1:$D$10"
End With

Sheets("sheet1").Select
Range("A1").Select

End Sub

Sheet1のA1からD10を範囲指定して、次いでSheet2のA1からD10も指定してます。
最後の2行で元のシートのA1を選択しました。
自動で元の位置に戻ってくれたほうがいいと思いますが、不必要なら削ってください。

 

Private Sub CommandButton2_Click()

ActiveSheet.PageSetup.PrintArea = ""

With Sheets("sheet2")
.Select
.PageSetup.PrintArea = ""
End With

Sheets("sheet1").Select
Range("A1").Select

End Sub

範囲選択解除です。


後は範囲指定毎にボタン(マクロ)を追加していけばいいです。

なんてことはないんですけど、便利です。

 

 

恵川商事 アカパックン 洗濯用 ピンク

恵川商事 アカパックン 洗濯用 ピンク

 

 

これでいい選択ができるよ。

(-_-;)(;-_-) チガウチガウ

Excelのセルはコピペでシェイプ(図形)になるんです

VBAじゃないけど。

 

Excelで既定の文字入りシェイプって少ないじゃないですか?

でも、セルに入力した値をセルごとシェイプ化できるんですよ。

これは結構便利だと思うんだけどなぁ

 

f:id:jus7733:20160527163202p:plain

セルに値(文字)を入れます。行列の幅高さを合わせておくと綺麗に仕上がります。

 

f:id:jus7733:20160527163310p:plain

適当なシェイプを用意します。なんでもいいです。

 

3

f:id:jus7733:20160527163355p:plain

値のセルをコピーします。

 

4

f:id:jus7733:20160527163441p:plain

シェイプの上にペーストします。

 

5

f:id:jus7733:20160527163552p:plain

コピー元のセルの上にシェイプが出来上がってます。

 

6

f:id:jus7733:20160527163639p:plain

わかりやすくするのに枠線消して、大きくもしてみました。

枠線もシェイプに含まれてますので、分かりやすいですね。

 

枠線を入れたくない場合は、値をコピーする前に[表示]タブを開き枠線のチェックを外し非表示にしましょう。

 

なんてこと無いんですが、知らない人多いみたいなんで。

 

 

 

Spoolerが起きてこないので無理やり起こす

WIN10にしてからなのか、その前の7の時からなのか覚えていないがwindowsサービスのPrintSpoolerを自動に設定していても起動してこない。

一度は起動していても印刷最中とかに突然お眠りになる。

管理ツールからいちいちサービス管理呼び出すのも名前を〜で呼び出すのもかったるい。

なんせ自分の使うPCでなく同僚(女の子)のなんで、呼ばれるのは嬉しいが、上記手続きは嫌。

で、バッチ作ってお呼ばれしたらさくっと直してしまおうという魂胆です(^_^;)

 

@echo off

set ServiceName=Spooler

net start  | find /i "%ServiceName%"

if %errorlevel%==0 (

   goto kanryo

) else (

   goto mokkai

)

:mokkai

net start %ServiceName%

if %errorlevel%==0 goto kanryo

rem エラー処理とか書くといいさ

:kanryo

(これ書いてるのmacwindowsで試してないから間違いあるかも?)

ServiceName=サービス名 にすればいろんなサービスに転用可のう・・・ん?

 もっと簡単にコレでいいじゃん・・・1行だ。

net start Spooler

で良いさ。

考えすぎだったな。

因みに止めるには net stop サービス名

止めて起動すれば再起動の動作です。

ただし、いずれにせよバッチは管理者権限で実行することが必要です。

やはり面倒なので、バッチファイルのショートカット作ってプロパティで管理者権限で実行にチェック入れてしまえばクリックひとつで実行できます。

 

注意!!

根本対策じゃないんで、あなたはちゃんとPCを直しましょうw

私は彼女のPCを直しませんが!なにか問題でも?

肥大化したExcelファイルを整理する

同僚が「このファイル、コピペするのにすごく時間がかかって応答しなくなる。」
というので、覗いてみたところファイルサイズが4MB弱あった。
内容はどう見積もっても500KB弱程度のはず・・・
シートが50個程度で、データ数は1シート100~500ぐらい。

で、最初に考えたのが図形を大量に入れてないか?でしたが、見ても見当たらない。
”編集”-”検索と選択”-”オブジェクトの選択と表示”とやってみると・・・
出るわ出るわでズラーっとリストアップされました、TextBoxが!しかも枠線なし!
見えないはずですよ~
とても数えられないので、VBEで以下を記述、実行。

Sub shapescount()
MsgBox ActiveSheet.Shapes.Count
End Sub

出ました。
その数3万弱(゚д゚)!

コピペコピペを繰り返し、7年間コツコツ集めたんですねw
削除には以下を記述して実行。

Sub del()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub

Selection.Deleteで何故かつまってしまうので、セレクトしたところで手動削除しました。
これらを各シートで実行し、全てのシェイプを削除しました。

が!がががが、まだ3MB弱のファイルサイズ。
なんで??

あるシートでCtrl+Shift+Endをやってみたところ、最終セルは2500行目あたり。
勿論データはそんなところには入っていない。一方、列は正常。

この異常な最終セルの設定が真犯人だったようで、約50シートの余分なセルを削除して上書き保存すると・・・
ファイルサイズは440KBになりました。

目視確認できないシェイプとコピペ乱用、シートの複製・列の挿入削除の乱発は面倒なことになるという教訓でした。
めでたしめでたしw

ん?ななねんかん?年度ごとにファイル分けてる・・?
ああ、やや少ないものの後6ファイル同様なのがあるんだ・・・・(´・ω・`)