忍者ブログ
ブログ主が仕事や個人的に学んだPC系・プログラミング系(VBAとかHTML)について書いていく備忘録ブログ。 ※ここで記載する内容はあくまで「個人的に」上手くいく内容です。ご使用には十分注意してください
[1] [2] [3
Posted by - 2017.08.24,Thu
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

Posted by 若槻風亜 - 2014.05.29,Thu

今回はこのブログ内でExcelのVBAをご紹介する際
必ずと言っていいほどよく出るプロシージャを
まとめておきます。


=======================
1.シートのセット
=======================
'■変数の宣言
Public WH1 As WorkSheet
Public WH2 As WorkSheet
Public WH3 As WorkSheet

'■シートセットのプロシージャ
Sub SheetSet()
  Set WH1 = Worksheets("シート名1")
  Set WH2 = Worksheets("シート名2")
  Set WH3 = Worksheets("シート名3")
End Sub
―――――――――――――――――――――――
これを作っておくと、たとえば
Sub AAA ()
  SheetSet '←これで呼び出し
  WH1.Range("A1").Value = "hhh"
End Sub

のように使えます。
上でやっているのは、WH1(=シート名1)の
A1セルに「hhh」を格納する、です。


シートのセットを変数で行っておく利点は、

 1.シート名が変更になった時にそこだけ
   直せば済む
 2.シートのプロパティが絶対予測で出てくる

があります。
ブログ主はExcelでプログラミングする際は
絶対に使うプロシージャの1つです。





=======================
2.描画の停止と開始等々
=======================

'■描画の停止他
Sub DontLook()
  '画面の移動を見せない
  Application.ScreenUpdating = False
  '確認メッセージを出さない
  Application.DisplayAlerts = False
  'マクロの動作が起因するイベント発生を抑制
  Application.EnableEvents = False
End Sub

このマクロを入れておくだけで画像のちらつきがなくなります。
ちなみにこの反対はこちら
'■描画の開始他
Sub OKLook()
  '画面の移動を見せる
  Application.ScreenUpdating = True
  '確認メッセージを出す
  Application.DisplayAlerts = True
  'マクロの動作が起因するイベント発生を抑制しない
  Application.EnableEvents = True
End Sub


ちなみに使い方は

Sub BBB ()
  DontLook
  (作業)
  OKLook
End Sub

という感じです。
値を次々に入れていく、などの作業の時は
あった方が目に痛くない優しいシステムに
なるのではないかと思います。

1番と併せて、ブログ主が絶対に使うプロシージャです。




ということで、このブログ内でよく使われる
プロシージャでした。



拍手[0回]

PR
Posted by 若槻風亜 - 2013.10.10,Thu

(対象)Excel VBA
(確認)Excel2003~


今回はExcel VBAで、ブックを開いた時・もしくは
閉じた時に自動で動くマクロについてです。


-------------------------------

1.ブックを開く時
 以下のように「auto_open」という名前のプロシージャを
 作成し、その中に行いたい処理を書くだけです。
 (データの読み込み処理など)
 
 '============================================
 ' ブックを開く時
 '============================================
 Sub auto_open()
   (ここに処理)
 End Sub

 
2.ブックを閉じる時
 以下のように「auto_close」という名前のプロシージャを
 作成し、その中に行いたい処理を書くだけです。
 (保存処理など)
 
 '============================================
 ' ブックを閉じる時
 '============================================ 
 Sub auto_close()
  (ここに処理) 
 End Sub
 

-------------------------------


以上、めちゃくちゃ簡単ですがブック開閉時の動作でした。


拍手[0回]

Posted by 若槻風亜 - 2013.07.27,Sat
(対象)Excel VBA
(確認)Excel2003


今回は自分で作るツールバーについてです。


マクロを作成した時、実行するために一番簡単なのは
VBAの画面でF5かF8を押すことですね。

その次はシートにボタンを作ってマクロを登録すること
でしょうか。


でもこう思うことはありませんか?

「どこのシートにいてもマクロを実行出来るようにしたい」

と。


ツールバーを使用すればそんな悩みは即解決してしまいますね。
作り方としては以下の通りになります。


----------------------------------
  '============================================
  'ツールバーの設置
  '============================================
  Sub ToolBarOn()
   Dim myBar      As CommandBar    'ツールバー
   Dim MyButton   As CommandBarButton 'ツールバーのボタン
   Dim CB     As Variant      'ツールバーの確認用
   Dim BCaption(1) As String      '表示文字列
   Dim BAction(1)   As String      '登録するマクロ
   Dim BText(1)   As String      'ボタンにカーソル当てた時の説明文
   Dim BFace(1)    As Integer      'ボタンに使うアイコン
   Dim I        As Long       '登録数分回すFor-Next用

   '■表示文字列の設定
   BCaption(0) = " 表示文字1 "
   BCaption(1) = " 表示文字2 "
   
   '■登録アクション(マクロ)設定=プロシージャ名
   BAction(0) = "ACT1"
   BAction(1) = "ACT2"

   '■説明文の設定
   BText(0) = "ボタンにカーソル当てた時の説明が入るよ"
   BText(1) = "ボタンにカーソル当てた時の説明が入るよ"

   '■フェイスIDの設定(一覧
   BFace(0) = 50
   BFace(1) = 300
   
   '■すでに同名のツールバーが存在する場合は削除
   Set myBar = CommandBars.Add
   For Each CB In CommandBars
     If CB.Name = "動作" Then
       CommandBars("動作").Delete
       Exit For
     End If
   Next

   '■ツールバーの名前を設定
   myBar.Name = "動作"
   myBar.Position = msoBarTop
   

   '■ツールバー作成(I = 登録するボタンの数)
   For I = 1 To 2
     Set MyButton = myBar.Controls.Add
     With MyButton
       .BeginGroup = True  ’ボタンとボタンの境界線
       .Style = msoButtonIconAndCaptionBelow '※
       .Caption = BCaption(I - 1)
       .OnAction = BAction(I - 1)
       .TooltipText = BText(I - 1)
       .FaceId = BFace(I - 1)
     End With
   Next 

   '■ツールバーの設置
   myBar.Visible = True
  End Sub



  '============================================
  'ツールバーの排除
  '============================================
  Sub ToolBarOff()
    Dim myBar As CommandBar
    Dim CB    As Variant

    For Each CB In CommandBars
      If CB.Name = "動作" Then
        CommandBars("動作").Delete
        Exit For
      End If
    Next
  End Sub

----------------------------------


これを実行するとツールバーが作成されます。

以前ご紹介した「ブックの開閉時の動作」に組み合わせると、
開いた時にツールバーを設置し、閉じる時に削除するという
動作が可能になります。


ちなみに、プログラム中の「※」部分についてですが、
ここを変更するとツールバーの表示のされ方が変わります。


下図がその結果です。

もしかしたらやり方がおかしくて上手くなってないところも
あるかもしれませんが。







以上、ツールバーを作ってみようでした。




拍手[1回]

Posted by 若槻風亜 - 2013.07.22,Mon

(対象)Excel VBA
(確認)Excel2003


今回はExcel VBAの小技集パート2を並べてみましょう。
内容によっては2007以降は使えないのでご注意ください。


--------------------------------

1.対象のブックを他に開いている人がいないか調べる

  = ActiveWorkbook.UserStatus
    ・・・UserStatus(n, 1) : ユーザー名
    ・・・UserStatus(n, 2) : ブックを開いた日時
    ・・・UserStatus(n, 3) : 共有(2)か否(1)か
    参照URL
    ※というかここの通りなだけなので細かいことはリンク先を見た方がいい


 (使用例)
   '===========================================================
   ' 対象のブックをほかに開いている人がいないかどうかを調べる
   '===========================================================
   Sub CheckAnotherUser()
     Dim Users As Variant
     Dim MSG  As String
     Dim I   As Integer

     '■変数に対象の結果を格納
     Users = ActiveWorkbook.UserStatus

     '■変数の最大数が1の場合は自分だけ、それ以上の場合は誰かが開いている
     '※UBound(配列変数) = 配列変数の最大要素数の取得
     If UBound(Users) = 1 Then
       MsgBox "他に開いているユーザーはいません"
     Else
       For I = 0 To UBound(Users) - 1
         MSG = Users(I, 1) & " : " & Users(I, 2) & vbCrLf
       Next
       MsgBox "あなた以外の誰かがブックを開いています : " & _
            vbCrLf & MSG
     End If
   End Sub


 (解説)
   今開いているブックを開いている人が自分以外に誰かいるかを確認。
   ブックを指定するならば「ActiveWorkbook」を「Workbooks(ファイル名)」に
   してもよい。


----------------------------------

2.範囲内の図形の削除
  参照URL


 (使用例)
   '===========================================================
   ' 範囲内の図形の削除
   '===========================================================
   Sub DeleteShape()
     Dim ShapTop As Double
     Dim ShapLeft As Double
     Dim ShapBotom As Double
     Dim ShapRight As Double
     

     '■指定セル範囲の上下左右の位置情報を取得
     With WHX.Range("A15:E30")
       ShapTop = .Top
       ShapLeft = .Left
       ShapBotom = .Top + .Height
       ShapRight = .Left + .Width
     End With
    

     '■シート内のオブジェクト全てを確認し、範囲内なら削除
     For Each OBJ In ActiveSheet.DrawingObjects
       If Not OBJ Is Nothing Then
         With OBJ
           If ShapTop <= .Top And ShapLeft <= .Left And _
            ShapBotom >= .Top + .Height And ShapRight >= .Left + .Width Then
             .Delete
           End If
         End With
       End If
     Next
   End Sub


 (解説)
   ★「ShapBotom = .Top + .Height」 = 上位置+高さ
   ★「ShapRight = .Left + .Width」 = 左位置+幅
   ★「ShapTop <= .Top」
      = オブジェクトの上位置が範囲の上位置より下
   ★「ShapLeft <= .Left」
      = オブジェクトの左位置が範囲の左位置より右
   ★「ShapBotom >= .Top + .Height」
      = オブジェクトの下位置が範囲の下位置より上
   ★「ShapRight >= .Left + .Width」
      = オブジェクトの右位置が範囲の右位置より左
  

   ※詳しくは下図参照※

   

----------------------------------


3.指定した文字列があったらその部分だけ文字を装飾する
  = 対象セル.Characters(Start:=*, Length:=*).Font.***
    ・・・Bold(太字)、ColorIndex(色)、Size(サイズ)など


 (使用例)
   '===========================================================
   ' 指定した部分だけ文字を装飾する
   '===========================================================
   Sub FontDecoration()
     Dim LG As Long
     Dim I As Long
     Dim J As Long

     '■最終行まで回して該当したら太字にして文字色を変える
     LG = Range("A65536").End(xlUp).Row
     For I = 1 To LG
       '△見ているセルに「ABC」が含まれるか
       If Range("A" & I).Value Like "*ABC*" Then
         '◆セルの中のABCの部分を探す
         J = InStr(1, Range("A" & I).Value, "ABC")
         Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True
         Range("A" & I).Characters(Start:=J, Length:=3).Font.ColorIndex = 10
       End If
     Next
   End Sub


 (解説)
   ★「J = InStr(1, Range("A" & I).Value, "ABC")」
     →Instr(スタート、対象文字列、検索文字列)

   ★「Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True」
     →Range("A" & I) = A列I行目のセルで
     →Start:=J    = J番目の文字から
     →Length:=3    = 3文字分を
     →Bold = True   = 太字にする
    ※ColorIndexの方も同じ意味合い


----------------------------------


1番は作業中に組み込むというよりも使いたいファイルを誰が開いているのか
確認したい場合などに使えますね。
(まあ、サーバーから使用者探す方法が出来る場合はそっちの方が確実ですが)


2番はシート内の全てを一気に消すんでも特定の図形だけを消すんでもないけど
一部分だけ一気に消したい、という時に使えますね。

ちなみに私は実作業でも使いましたし作成途中などでも使いました。
図形の数が多いと便利です。


3番は何かしら検索した結果を目立たせる時などに使えますね。

全部じゃなくて一部だけ装飾したい、って意外にあると思うので
あれば便利かなと思います。


拍手[0回]

Posted by 若槻風亜 - 2013.07.16,Tue
(対象)Excel VBA
(確認)Excel2003


今回はExcel VBAの小技集を並べてみましょう。
内容によっては2007以降は使えないのでご注意ください。
--------------------------------
1.テキスト型のデータを日付型に変換
  = Format(CDate(Format(テキスト型日付, "0000/00/00")), "m/d")


 (使用例)
   Sub Test001()
              Dim MyStr As String
             MyStr = "20130716"
             MyStr = Format(CDate(Format(MyStr, "0000/00/00")), "m/d")
            Debug.Print MyStr
      End Sub


 (解説)
   ★Format(MyStr, "0000/00/00")
    = MyStrの中身を/区切りの形に変更
   ★CDate(***)
    = ***の部分を日付に変更する(この場合は「2013/07/16」)
   ------------------------------------------------------------
   <ここから下はなくても使える>
   ★Format(***, "m/d")
    = ***の部分を「m/d」の形に変える(この場合は「7/16」)
----------------------------------
2.チェックボックス追加
  = CheckBoxes.Add(Top, Left, Width, Height)
    ・・・Top   : チェックボックスの上位置
    ・・・Left  : チェックボックスの左位置
    ・・・Width  : チェックボックスの幅
    ・・・Height : チェックボックスの高さ
 (使用例)
   '===========================================================
   ' チェックボックスを10個作る
   '===========================================================
   Sub CheckAdd()
    Dim I As Long
     For I = 1 To 10
      '■適当なサイズと位置でチェックボックスを作成し、選択
       ActiveSheet.CheckBoxes.Add(45, 145, 24, 16.5).Select
       '■チェックボックスの設定
       With Selection
         .Caption = ""            '表示文字
         .Name = "Check" & I      'コントロールの名前
         .Value = xlOn            'チェックの有無(On = True、Off = False)
         .LinkedCell = "$A$" & I  'リンクするセル
         .Top = ActiveSheet.Range("A" & I).Top    '上位置
         .Left = ActiveSheet.Range("A" & I).Left  '左位置
       End With
     Next
   End Sub
 (その他)
   Top~Heightの値はRangeから取る事も可能。
   <例>
    .CheckBoxes.Add(Top:=Range("A10").Top, _
                                 Left:=Range("A10").Left, _
                                 Width:=Range("A10").Width, _
                                 Height:=Range("A10").Height)
----------------------------------
3.カレントフォルダを変更する1
  = CreateObject("WScript.Shell").CurrentDirectory = "***"
    ・・・*** : フォルダパス。「\\ABC\AAA\BBB\」や「C:\」など
 (使用例)
   '===========================================================
   ' カレントフォルダを変更してファイルを開く1
   '===========================================================
   Sub MoveCurrentFolder()
     Dim MyFile As String
     '■指定フォルダにカレントフォルダを移動
     CreateObject("WScript.Shell").CurrentDirectory = "C:\"
     '■ファイルを開くダイアログを表示し、選択結果を変数に格納
     MyFile = Application.GetOpenFilename( _
            FileFilter:="Excel ファイル (*.xls; *.xlsx),*.xls; *.xlsx")
     '■結果を表示
        MsgBox MyFile
   End Sub
 (その他)
   主にネットワークドライブに移動する際に使える手段。
   ローカルドライブなら「ChDir」を使った方が簡単だと思われる。
   変更したドライブはExcelを終了した時点でリセットされるので
   次に開いた時にはいつも通りのカレントドライブが開く。
----------------------------------
4.カレントフォルダを変更する2
  = Declare Function SetCurrentDirectory Lib "kernel32" Alias _
                 "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
    ・・・Sub-End Subより外で宣言。SetCurrentDirectoryの宣言文
       参照URL
    ----------------------------------------------------------------------
    SetCurrentDirectory ThisWorkbook.Path
    ・・・SetCurrentDirectoryの実行文
 (使用例)
   '===========================================================
   ' カレントフォルダを変更してファイルを開く2
   '===========================================================
   Sub MoveCurrentFolder2()
     Dim MyFile As String
     '■指定フォルダにカレントフォルダを移動
     SetCurrentDirectory ThisWorkbook.Path
     '■ファイルを開くダイアログを表示し、選択結果を変数に格納
     MyFile = Application.GetOpenFilename( _
            FileFilter:="Excel ファイル (*.xls; *.xlsx),*.xls; *.xlsx")
     '■結果を表示
     MsgBox MyFile
   End Sub


 (その他)
   言いたいことは1番と同じなので省略



----------------------------------
1番は使いどころが限定されますが、2番はたくさん作りたい時に便利ですし、
3番4番はユーザーにファイルを選択させたい時等々に便利だと思います。
少々説明を投げている部分もありますので、もっと詳しく知りたい! という場合は
グーグル先生に尋ねてみてくださいな。
有名な内容ばかりですので、分かりやすい説明を乗せているサイトさんに
めぐり合えると思います。

拍手[0回]

プロフィール
HN:
若槻風亜
性別:
女性
職業:
会社員
趣味:
創作、プログラミング
自己紹介:
仕事や個人で学んだことをまとめておきたかったがために備忘録ブログを立ち上げました。
あくまで自分が学んだこと・自分が出来たことなので、ご覧くださる場合は参照レベルでお願いします。
ブログ内検索
カレンダー
07 2017/08 09
S M T W T F S
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31
P R
最新トラックバック
コガネモチ
フリーエリア



Template by mavericyard*
Powered by "Samurai Factory"
忍者ブログ [PR]