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

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

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回]

PR
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回]

Posted by 若槻風亜 - 2013.07.06,Sat

(対象)Excel VBA
(確認)Excel2003


今回は指定したブックが開いているか否かのファンクションです。

たとえば外部ファイルを開いてそこにある値を持って来たい時、
すでに開いているとエラーになったりしませんか?
(ブログ主は時々なります←開きっぱなしにすることがある)

そんな時、とりあえず開いているかいないかの確認をする
ファンクションです。

これ以外の方法も(作ったこと忘れたので)色々やっていますが、
とりあえず一番単純なものを。

これの結果次第でエラーとして処理するか開く動作を無視して
そのまま次の動作にいくかもあなた次第。





'==============================================================
' ファンクション
' : 指定したブックが開いているかどうかの判断(True/False)
'==============================================================
Function CheckOpenBook(CheckBookName As String) As Boolean
  '■ワークブック変数を宣言
  Dim WB_A As Workbook
  
  '■初期化
  CheckOpenBook = False
  
  '■開いているブックを全て探し、指定したファイルの有無を確認
  For Each WB_A In Workbooks
    If WB_A.Name = CheckBookName Then
      CheckOpenBook = True
      Exit For
    End If
  Next
End Function
――――――――――――――――――――――――――――――――

(使い方例)
Dim Flg as Boolean
Flg = CheckOpenBook("aaa\bbb.xls")
If Flg Then
  Msgbox "開いてるよ"
Else
  Msgbox "開いてないよ"
End If


→指定したファイルが開いていたらTrue、開いてなかったら
 Falseを返すので、その値によって処理を分ける



ちょいちょい役立つものだと思います。

ちなみに、探すと似たようなもの書いたサイトさん
いっぱい出てきます。

真面目に作ってる方多いので、大変参考になります。

拍手[0回]

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



今回は列番号から列名を取得するファンクションと
列名から列番号を取得するファンクションです。

列名から~はあんまり使いませんが、列番号から
列名を取得する方のファンクションは結構使えると
思います。



'==============================================
' 列番号を列名に変換
'==============================================
Function RetuHenkan(ByVal K As Integer) As String
  Dim RetuMei As Variant
  Dim RetuA   As Integer
  Dim RetuB   As Integer
  RetuMei = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _
                  "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
  If K > 26 Then
    RetuA = Int(K / 26)
    RetuB = K Mod 26
    If RetuB = 0 Then
      RetuA = RetuA - 1
      RetuB = 26
    End If
    RetuHenkan = RetuMei(RetuA - 1) & RetuMei(RetuB - 1)
  Else
    RetuHenkan = RetuMei(K - 1)
  End If
End Function
――――――――――――――――――――――――――――――――

(使い方例)
Dim Retu as String
Dim i        as Integer
For i = 1 to 20
  Retu = RetuHenkan(i)
  ActiveSheet.Range(Retu & "2").Value = "In!"
Next

(説明)
Iを1から20まで回し、Iの値が何列かを求める。
例だとA列からT列までが対象になる。
AA列以降も使えるようにはなっている(はず)



'==============================================
' 列名を列番号に変換
'==============================================
Function RetuMeiHenkan(ByVal Retu As String) As Integer
  Dim RetuMei As Variant
  Dim RetuA   As Integer, RetuB   As Integer
  Dim RetuC   As String, RetuD    As String
  RetuMei = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _
                  "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
  
  
  RetuC = Join(RetuMei, "")
  If Len(Retu) > 1 Then
    '1文字目
    RetuD = Left(Retu, 1)
    RetuA = InStr(RetuC, RetuD)
    
    '2文字目
    RetuD = Right(Retu, 1)
    RetuB = InStr(RetuC, RetuD)
    
    RetuMeiHenkan = (RetuA * 26) + RetuB
  Else
    RetuA = InStr(RetuC, Retu)
    RetuMeiHenkan = RetuA
  End If
End Function
――――――――――――――――――――――――――――――――

(使い方例)
Dim i as Integer
Dim j as Integer
Dim k as Integer
i = RetuMeiHenkan("A")
j = RetuMeiHenkan("T")
For k = i to j
  ActiveSheet.Cells(2 , k).Value = "In!"
Next

(説明)
AとTを指定して各列の列番号を取得。
その分だけFor文を回して処理が行える。
AA列以降も可能な(はず)



拍手[0回]

Posted by 若槻風亜 - 2013.07.03,Wed
(対象)Access VBA
(確認)Access2003


今回はマウスホイールの制御についてです。



「Access VBA マウスホイール制御」
――――――――
○やりたいこと
――――――――
→フォームでマウスホイールをするとレコードが移動してしまうので
 それをなくす
――――――――
○ソース
――――――――
Dim bbb As Integer
'=============================================
' フォームの読み込み時
'=============================================
Private Sub Form_Load()
  bbb = 0
End Sub
――――――――
☆やっていること
――――――――
フォームの読み込み時に変数bbbに0を入れる
'=============================================
'レコード移動時 
'=============================================
Private Sub Form_Current() 
 If Me.NewRecord Then Exit Sub 
 
 Me.[コントロール名].SetFocus 
 Me.Dirty = True 
End Sub 
――――――――
☆やっていること
――――――――
レコード移動時の処理。
 1.次のレコードが新しいレコードの時は作用しない 
 2.どれでもいいからコントロールを選んでおく。
  これを選ばないとエラーになる 
 3.「Dirty」はカレントレコードの変更の有無を表す。
   今はTrueなので変更有り→変更有り=更新前処理が入る 
'=============================================
' マウスホイールを動かした時
'=============================================
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
  bbb = Count
End Sub
――――――――
☆やっていること
――――――――
マウスホイールが動かされたらbbbにCountの値を入れる
(Countの値=ホイールされて動こうとしているレコードの数)
'=============================================
' レコードに変更があった時
'=============================================
Private Sub Form_BeforeUpdate(Cancel As Integer)
  If bbb <> 0 Then
    Cancel = True
    bbb = 0
  End If
End Sub
――――――――
☆やっていること
――――――――
bbbの値が0でない時にCancelをTrueにして処理をキャンセルする。
※1ここでキャンセルされると移動もキャンセルになる
※2判断は必ず「0でない」にする。bbbの値はマイナス値にもなる
※3bbbの値を初期化しておく
(上のレコード移動時の処理を超えると自動的に入ってくる)
=======================



拍手[1回]

プロフィール
HN:
若槻風亜
性別:
女性
職業:
会社員
趣味:
創作、プログラミング
自己紹介:
仕事や個人で学んだことをまとめておきたかったがために備忘録ブログを立ち上げました。
あくまで自分が学んだこと・自分が出来たことなので、ご覧くださる場合は参照レベルでお願いします。
ブログ内検索
カレンダー
04 2017/05 06
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]