日曜プログラマの開発日記

カテゴリ: VBA

こんな感じでAutoOpenとAutoCloseに記載すると、ツールバーが作れますよ。



'****************************************************************************
'* フォーマット作成 Auto_Open
'****************************************************************************
Sub Auto_Open()
' ==============================================================================
' ファイルオープン時の設定
' ------------------------------------------------------------------------------
Dim Btn As Object
Dim PopReFrm

'  ツールバー設定
Set PopReFrm = Excel.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup)
PopReFrm.Tag = "ReFrm"
PopReFrm.Caption = "【ユーザー管理】"

'フォーマット作成
Set Btn = PopReFrm.Controls.Add(Type:=msoControlButton)
Btn.Caption = "【LDAP出力】"
Btn.OnAction = ThisWorkbook.Name & "!ModUserconv.MakeOpenLDAPFile"

Set Btn = PopReFrm.Controls.Add(Type:=msoControlButton)
Btn.Caption = "【Moodle出力】"
Btn.OnAction = ThisWorkbook.Name & "!ModMoodleUser.moodleUserMake"

Set Btn = PopReFrm.Controls.Add(Type:=msoControlButton)
Btn.Caption = "【Pass作成】"
Btn.OnAction = ThisWorkbook.Name & "!ModPassMake.passMake"



Btn.FaceId = 0

End Sub
'****************************************************************************
'* フォーマット作成 Auto_Close
'****************************************************************************
Sub Auto_Close()
' ==============================================================================
' ファイルクローズ時の設定
' ------------------------------------------------------------------------------
Excel.CommandBars("Worksheet Menu Bar").FindControl(Type:=msoControlPopup, Tag:="ReFrm").Delete

End Sub
       
★ランキング参加中★

我が家のわんこをぽちっ♪とねっ(別ウインドウで開きますよ~)

にほんブログ村へ
にほんブログ村

VBAで普通に出力するのもよいのですが、明示的にUTF8を指定して、
ファイルを出力したいなーと思って作ってみました。
一部、ロジックが入ってますが、こんな感じですかね。


'****************************************************************************************************
'*
'* Moodle用ユーザーIDファイル作成 UTF8で出力
'*
'****************************************************************************************************
Sub moodleUserMake()

OutMoodleFile = OutDirName & OutMoodleFileName
Set ADOobj = CreateObject("ADODB.Stream") 'ADOのストリームオブジェクトを用意
ADOobj.Charset = "UTF-8" '出力する文字コード
ADOobj.Open 'オープン

ActiveWorkbookName = ActiveWorkbook.Name 'ワークブックの名前を取得
Set InputWorkSheet = ActiveWorkbook.Worksheets("ユーザーID設定値") 'ワークシートの名前を取得
Set InputMoodleSheet = ActiveWorkbook.Worksheets("Moodle用ヘッダ") 'ワークシートの名前を取得

InputLastRow = InputWorkSheet.Range("D" & "65536").End(xlUp).Row 'ユーザーIDの最終行を取得する。

'ヘッダファイル出力
wkHeadData = ""
wkHeadData = wkHeadData & Trim(InputMoodleSheet.Cells(1, 1).Value)
For wkIndex = 2 To 100
If Trim(InputMoodleSheet.Cells(1, wkIndex).Value) = "" Then
Exit For
Else
wkHeadData = wkHeadData & "," & Trim(InputMoodleSheet.Cells(1, wkIndex).Value)
End If
Next wkIndex

'ヘッダ出力
ADOobj.WriteText wkHeadData & vbLf

For wkIndex = 2 To InputLastRow

'入力データの取得
InputUserID = InputWorkSheet.Cells(wkIndex, conUserIdCol).Value
InputFastName = InputWorkSheet.Cells(wkIndex, conFastNameCol).Value
InputLastName = InputWorkSheet.Cells(wkIndex, conLastNameCol).Value
InputPasswordBfr = InputWorkSheet.Cells(wkIndex, conPasswordBfrCol).Value
InputMailAddress = InputWorkSheet.Cells(wkIndex, conMailAddressCol).Value

wkOutputData = InputUserID & "," & InputPasswordBfr & "," & _
InputLastName & "," & InputFastName & "," & InputMailAddress

ADOobj.WriteText wkOutputData & vbLf

Next wkIndex

ADOobj.SaveToFile OutMoodleFile, 2 '1:追加モード、2:上書きモード
ADOobj.Close 'クローズ
Set ADOobj = Nothing '解放
MsgBox "処理が終了しました。" & vbCrLf & "" & OutDirName & OutMoodleFileName & "をご確認ください。"

End Sub
       
★ランキング参加中★

我が家のわんこをぽちっ♪とねっ(別ウインドウで開きますよ~)

にほんブログ村へ
にほんブログ村

テストデータを作るのに、ExcelでユーザーIDやパスワードを作ってましたが、
暗号化が面倒になって、VBAで関数作ってみました。
これだと、楽勝。


'****************************************************************************************************
'*
'* パスワードの暗号化(SHA1 → base64エンコード)
'*
'****************************************************************************************************
Public Function passSHA1(wkPassword As String)

BYTES = CreateObject("System.Text.UTF8Encoding").GetBytes_4(wkPassword)

Set SHA1 = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
SHA1.ComputeHash_2 (BYTES)

Set MSXML = CreateObject("MSXML2.DOMDocument")
Set EL = MSXML.CreateElement("tmp")
EL.DataType = "bin.base64"
EL.NodeTypedValue = SHA1.Hash
passSHA1 = EL.Text

End Function





       
★ランキング参加中★

我が家のわんこをぽちっ♪とねっ(別ウインドウで開きますよ~)

にほんブログ村へ
にほんブログ村

このページのトップヘ