VBA　Tips

1. ComboBoxに値を追加する

• AddItemを使用する。

With Me.ComboBox1
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .ListRows = 3 '表示する行数
End With

• コンボボックスをクリックしたら文字を繰り返し代入して３行分表示する。

Private Sub ComboBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
For A = 1 To 3
    ComboBox1.AddItem CStr(A)
Next
    ComboBox1.ListRows = 3
End Sub

2. Menuの作成

Sub Menu_Set()
  Application.CommandBars("Cell").Reset
  With CommandBars("Cell").Controls.Add(Before:=1)
    .Caption = "メニュー1"
    .OnAction = "menu1"
  End With
  With CommandBars("Cell").Controls.Add(Before:=1)
    .Caption = "メニュー2"
    .OnAction = "menu2"
  End With
End Sub

Sub Menu_Reset()
  Application.CommandBars("Cell").Reset
End Sub

3. Workbookのイベント処理

Private Sub Workbook_Activate()
Menu_Set 'ファイルがアクティブになったら
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Menu_Reset 'ファイルが閉じたら
End Sub

Private Sub Workbook_Deactivate()
Menu_Reset '別のファイルになったら
End Sub

Private Sub Workbook_Open()
Menu_Set 'ファイルが開いたら
End Sub

4. CSVに書き込みしてUTF8で保存

Sub writeCSV_utf8()
Dim sn As String
Dim csvFile As String
sn = ActiveSheet.Name
Dim Ccnt As Long'列数

csvFile = ActiveWorkbook.Path & "\" & sn & "_utf8.csv"

'ADODB.Streamオブジェクトを生成
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")

Dim strLine As String
Dim i As Long, j As Long
i = 1

With adoSt
    .Charset = "UTF-8"
    .LineSeparator = adLF
    .Open

'列数をカウントする。

Ccnt = 1

Do Until Cells(1, Ccnt) = ""
	Ccnt = Ccnt + 1
Loop

Do While Cells(i, 1).Value <> ""
        strLine = ""
        j = 1
        For j = 1 To Ccnt - 2
            strLine = strLine & """" & Cells(i, j).Value & """" & ","
        Next
        strLine = strLine & """" & Cells(i, j).Value & """"
        .WriteText strLine, adWriteLine
        i = i + 1
Loop
    .SaveToFile csvFile, adSaveCreateOverWrite
    .Close
End With

MsgBox sn & "_utf8.csvに書き出しました"

End Sub

5. 資格情報を登録してネットワークフォルダを開く

Sub OpenNetworkFolder()
Set ShellObj = CreateObject("WScript.Shell")
  result = ShellObj.Run("cmdkey /add:192.168.0.44 /user:hoge /pass:hogehoge")
    If (result = 0) Then
      '■通常サイズで表示(IPアドレスで指定)
	Shell "C:\Windows\Explorer.exe " & "\\192.168.0.44\TargetFolder", vbNormalFocus
    Else
        MsgBox ("問題が発生しました。管理者に問い合わせをしてください。")
    End If
    
    '後片付け
    Set ShellObj = Nothing
  
  
End Sub