タグ: VBA

このブログのアクセスって明らかに平日が多い。
記載した技術情報が役に立ってくれれば幸いなのだが・・・

さて、ファイルの所有者ってとってこれんのか？って話。
とってこれるみたい。

Kameya blog「VBScriptでフォルダ・ファイルの所有者の確認を行う」を参考に、ExcelVBAで作成してみた。

'-----------------------------------------------------
' ファイルの所有者を取得する
' 引数　：ファイルパス(File Only)
'-----------------------------------------------------
Private Function GetOwner(fpath As String) As String
    
    Dim WMIService  As Object
    Dim objSet      As Object
    Dim obj         As Object
    Dim buf         As String
    
    'ちゃんと渡してよ！って抜ける
    If Len(fpath) = 0 Then Exit Function
    
    Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    
    buf = ""
    
    'TODO 本当はちゃんとエスケープしないとダメ
    Set objSet = WMIService.ExecQuery("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" _
                                    & Replace(fpath, "\", "\\") _
                                    & "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")
    For Each obj In objSet
        buf = buf & obj.AccountName & ","
    Next
    If Len(buf) > 0 Then
        GetOwner = Left(buf, Len(buf) - 1)
    End If
    
    Set obj = Nothing
    Set objSet = Nothing
    Set WMIService = Nothing

End Function

参照したサイトだと記載されていなかったのだが、¥マークは二重にしないといけない。
（常識？いや、CとかC++とかC#とか・・・ならともかく、VB書いてるときは頭がBasicモードになってしまい、忘れてしまうのだ。）
フォルダの所有者を確認するときは、WHERE句が変わるはず。

Excelのデータを1行ずつ挿入していくのが面倒なので、シートまるっとINSERTをやってみた。

引数は以下の通り
workbook_path：元データのブック
sheet_name：workbook_pathのどのシートを元データとするのか指定
db_src：DBの場所
db_name：DBの名前
login_id：DBのユーザID
login_pw：DBのユーザパスワード
table_name：DBのどのテーブルを操作するのか（ここではデータの投入先）

Private Function ExportFromXLSX(workbook_path as String,sheet_name as String, db_src as String, db_name as String,login_id as String, login_pw as String, table_name as String) As Boolean

	Dim cn as ADODB.Connection
	Dim recs_aff as Long

	On Error Goto ErrFunc
	
	Set cn = New ADODB.Connection

	'2007バージョンのExcelファイルを開く
	cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & workbook_path & ";" & _
	        "Extended Properties=Excel 12.0"

	'Jetプロバイダを使用してインポート
	sql = "INSERT INTO [odbc;Driver={SQL Server};" & _
						"Server=" & db_src & ";" _ 
						& "Database=" & db_name & ";"  _
						& "UID=" & login_id  _
						& "PWD=" & login_pw _
						& "]." & table_name _
						& " SELECT * FROM [" & sheet_name & "$]"
	    
	cn.Execute sql, recs_aff, adExecuteNoRecords
	cn.Close
	Set cn = Nothing

	ExportFromXLSX = True
	Exit Function
	
ErrFunc:
	
	'エラーメッセージ表示
	' ---- (省略) ----
	
	If Not cn Is Nothing Then
		If cn.State=1 Then cn.Close
		Set cn = Nothing
	End If
	
End Function

こんなことやらなきゃいけないのは、SQLServer側からExcelシートの内容をとってこようとしたときに、分散クエリほにゃほにゃ・・・というエラーが出てしまったからなのだ。
なのでExcelシートから、SQLServer側に送るイメージ。

今日は昨日やったことの続きをやろうと思っていたら、昨日作ったロジックがどうも思い通りに動いていない。

検索絡みだ。

Find関数を使って、セル範囲内の値検索をしたかったのだが、同値のセルを検索してくれないとキタ。
Find(…) →　FindeNext() を最初のセル、または戻り値がNothingになるまで繰り返すのだが、どうもうまくいかない。

で、結合セルが含まれているせいで、検索がうまくいかないのかと、結合セルをすべて解除させたシートを一つ作って、Ctrl+Fで検索してみたのだが、やはりうまくいかなかった。

Ctrl＋Fの検索ダイアログでうまくいかないものをマクロでうまくいかそうなどというのは、無駄な抵抗なので、もう行列全体を１つ１つ当たっていくことにした。

With Worksheets(xx)
    For c=1 to 100 Step 1
    　　For r=1 to 100 Step 1
    　　　　If Cstr(.Cells(r,c).Value) = CheckText Then
                  ''' ここに処理 '''
            End If
            ''' ここに下の結合セルのMax行数抽出のサンプル挿入 '''
    　　Next r
    Next c
End With

こんな感じに１セルずつ当たっていくわけ。なんとも、面倒な話だが、仕方がない。

しかし、対象セル範囲の中に結合セルがあるので、厄介だ。
というより、結合されている場合は、先頭のセルだけ確認すればよいわけで、検索時間を短縮できると考えた。

下の「結合セルのMax行数抽出のサンプル」は縦結合しかされていないので、横結合の場合はまた変わってくるわけだが・・・

    Dim rng As Range   '確認対象セルを設定すること
    If Not rng.MergeCells Then
        '結合されていない場合
        min_row = rng.Row
        max_row = rng.Row
    Else
        '結合されている場合
        min_row = rng.MergeArea.Cells(1, 1).Row
        max_row = SearchMergeRowMin + rng.MergeArea.Rows.Count - 1
    End If

次に確認するセルは、同じ列の max_row＋1 となる。

Application.Workbooks.Add
で新規ブックを作ることはできるのだが、2003バージョンで上限が6.5万行ぐらいのシートができてしまった。

これを強制的に100万行対応のファイルにできないものかと思っていたところ、

Dim def As XlFileFormat ‘DefaultSaveFormat 保管場所
With Application
　　def = .DefaultSaveFormat
　　.DefaultSaveFormat = xlExcel12 ’50 Excel2007-
　　.Workbooks.Add
End With

というふうにApplication.DefaultSaveFormatプロパティを一時的に変えてから新規ブックを作成してやればよいことがわかった。
処理の最後に、また元の値(def)に戻してやればよい。

なんだかんだで、Zoo Keeper対戦中。
文句言ってても、結局すきなんだろぉ～・・・えぇ好きです（ポッ）、と下らん一人芝居をしたところで、メモ。

‘———————————————————

まずは、Excelマクロのロックあれこれ。

Const LOCK_PW as String = "pw"
Dim wb as Workbook
Dim ws as Worksheet
Dim rng as Range

と仮設定して・・・

‘ブックのロック/ロック解除

wb.Protect LOCK_PW     'ロック
wb.UnProtect LOCK_PW   '解除

‘シートのロック/ロック解除

If Not ws.ProtectContents Then ws.Protect LOCK_PW , AllowFiltering:=True    'ロック
If ws.ProtectContents Then ws.UnProtect LOCK_PW   '解除

（ロックしてもオートフィルターは使えるようにしといたほうが無難）

‘セルのロック/ロック解除

rng.Locked = True     'ロック
rng.Locked = False    '解除

シートはロックされているかどうか確認するプロパティがあるので、ロックがかかっていなければロックをかけるようにしないと、Excel2013ではロック・ロック解除に時間がかかるので、無駄に時間を食うロジックになってしまう。
セルロックはセルのロックをかけてもシートロックかけてないと有効にはならないので注意。

‘———————————————————

‘セルが数式なのかどうか

If rng.HasFormula Then
    '数式です！
Else
    '数式じゃありません！
End If

シートコピーとかするとグラフとデータをまるっとコピーできるが、そういうわけにもいかないときもある。
例えば、グラフのデータが別シートにあるとき。
これは困ったものだ、どうしたものか・・・と悩んでいたら、

「図でコピーして図で保存しておけばよいではないか！」

と思い立った。
これなら、グラフの元データの場所を考える必要ないし、ピクチャ形式で保存しておけば、容量もさほどとらないのではと思い、早速マクロを組んでみる。

CopyPictureというプロシージャ（関数）を利用するのだが、貼り付け関数は、シート関数にしかないので、貼り付けたいセルをSelectしてから、シート関数で貼り付けるという、少々バカバカしいというか、わざわざSelectする手間がいるところが嫌なところだ。

とりあえず、組んで走らせてみると、想定通りグラフは図形として貼りついて、オホホホホーーーとか思っていたら、動作検証をしてくださっているお客様から、

「うまくいかないんですよね～」とメールがやってきた。

やってみると、本当にうまくいってない。
グラフのプロットエリアがどんどんずれていって、プロットエリアが小粒になってしまっておる。

なぜじゃ！ナゼにじゃ!!

私が触ってた時はうまくいってたのに・・・と思って色々試すと、うまくいくときといかないときがある。

こういうのが一番困るんだよ。

と思いながら眺めていたら、どうやらシートの表示（ズーム）に影響しているのだと分かった。
解像度とかの絡みなのだろうか。

とりあえず、コピー元シートをアクティブにして、
　ActiveWindow.zoom = 100
とした後で、貼り付け先シートに貼り付けてやると、プロットエリアがずれないで貼りつくようになった。

おそらく、コピー元と貼り付け先のズームを同じにしてやらないと、綺麗には貼りついてくれないのだろう。
やれやれ、まったく困ったものだ。

Excelマクロのお勉強。
WorkbookやFormといったオブジェクトにデフォルトで備わっているプロシージャ（メソッド）って、どんな順番で呼び出されるのよ？って思ったので調べてみた。
今更だけど・・・
ちなみにバージョンは2003。

ブックを開いたとき（起動時）

Workbook_Open
Workbook_Activate
Workbook_WindowActivate

※ブックをVisible=FalseにしたときはActivateプロシージャは走らないと思うので、基本はOpenプロシージャに処理を書く。

ブックを閉じるとき（終了時）

Workbook_BeforeClose
Workbook_WindowDeactivate
Workbook_Deactivate

※起動時と同様。

フォームロードしたとき

UserForm_Initialize

フォーム.Showしたとき

UserForm_Layout
UserForm_Activate

フォーム.Hideしたとき

なし

フォームアンロードしたとき

UserForm_QueryClose
UserForm_Terminate

QueryCloseとTerminateの違いは何？って思ったけど、QueryCloseはアンロードの起動処理で、Terminateはホントのアンロード処理という感じ。
つまり、アンロードの起動処理なのでアンロードするかどうかプロシージャ内で分岐できるのがQueryClose。CancelパラメータにTrueを設定するとアンロードを中止できる。
QueryCloseで何事もなければTerminateプロシージャが呼び出されて、アンロード処理の記載ができるようだ。

カーソルが当たったときの処理はEnterに記載。

Sub TextBox1_Enter()
・・・・
End Sub

カーソルがはずれたときの処理はExitに記載。

Sub TextBox1_Exit()
・・・・
End Sub

だそうな。

休日を自動的に作成するマクロを作成中、ハッピーマンデーってどうやって求めるのかを考えた。

色々サイトを見たのだけれど、「結局どうやってやるのよ！」とか、「なんでこんなにこねくり回してるのよ！」とか、まぁとにかくあんまり参考になりそうなロジックがきれいに提示されているサイトがなかったので自分で作った。

引数に、年、月、週を設定すると、Date型の日付が返る仕組み

Private Function GetMondayDateFromYearMonthWeek(ByVal y As Integer, ByVal m As Integer, ByVal w As Integer) As Date

Dim t As Date

t = DateSerial(y, m, 1)
t = DateAdd(“d”, (8 – Weekday(t, vbMonday)) Mod 7, t) ‘1週目の月曜日
GetMondayDateFromYearMonthWeek = DateAdd(“d”, 7 * (w – 1), t)

End Function

例えば、GetMondayDateFromYearMonthWeek(2012,9,3)　とすると、戻り値は2012/9/17となる。

たぶんうまくいくと思うけど、2012年でしか試してない・・・

例えば、2003と2007両方インストールしていた場合、後でインストールしたバージョンで起動するようになっているので、常に2003で起動させたいというときは、以下のコマンドをスタートボタン＞ファイル名を指定して実行で実行させる。

“C:\Program Files\Microsoft Office\OFFICE11\excel.exe” /regserver

パスはインストール環境によって違うので注意。
OFFICE11ってのをOFFICE12とかに変えれば、常時2007で起動とかになるハズ。