ブログ主が仕事や個人的に学んだPC系・プログラミング系（VBAとかHTML）について書いていく備忘録ブログ。
※ここで記載する内容はあくまで「個人的に」上手くいく内容です。ご使用には十分注意してください
Posted by 若槻風亜 - 2013.07.16,Tue
（対象）Excel VBA
（確認）Excel2003
（確認）Excel2003
今回はExcel VBAの小技集を並べてみましょう。
内容によっては2007以降は使えないのでご注意ください。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
１．テキスト型のデータを日付型に変換
＝ 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」）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
２．チェックボックス追加
＝ 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)
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
３．カレントフォルダを変更する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を終了した時点でリセットされるので
次に開いた時にはいつも通りのカレントドライブが開く。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
４．カレントフォルダを変更する2
＝ Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
・・・Sub-End Subより外で宣言。SetCurrentDirectoryの宣言文
----------------------------------------------------------------------
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番はユーザーにファイルを選択させたい時等々に便利だと思います。
少々説明を投げている部分もありますので、もっと詳しく知りたい！ という場合は
グーグル先生に尋ねてみてくださいな。
有名な内容ばかりですので、分かりやすい説明を乗せているサイトさんに
めぐり合えると思います。
[1回]
PR
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
今回は列番号から列名を取得するファンクションと
列名から列番号を取得するファンクションです。
列名から～はあんまり使いませんが、列番号から
列名を取得する方のファンクションは結構使えると
思います。
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列以降も可能な（はず）
（確認）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列以降も使えるようにはなっている（はず）
（使い方例）
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回]
プロフィール
ＨＮ：
若槻風亜
性別：
女性
職業：
会社員
趣味：
創作、プログラミング
自己紹介：
仕事や個人で学んだことをまとめておきたかったがために備忘録ブログを立ち上げました。
あくまで自分が学んだこと・自分が出来たことなので、ご覧くださる場合は参照レベルでお願いします。
あくまで自分が学んだこと・自分が出来たことなので、ご覧くださる場合は参照レベルでお願いします。
ブログ内検索
カレンダー
最新記事
(12/31)
(12/30)
(03/27)
(11/09)
(10/07)
P R
最新トラックバック
コガネモチ
フリーエリア
Template by mavericyard*
Powered by "Samurai Factory"
Powered by "Samurai Factory"