'開いているブックリストを取得
Private Sub cmbBookGet_Click()
Dim WBK As Workbook
cmbBooklist.Clear
For Each WBK In Workbooks
コンボボックス.AddItem (WBK.name)
Next WBK
End Sub
'対象のブックからフォームリストを取得
Private Sub cmbBooklist_Change()
Dim i As Long
Dim wkBk As Workbook
cmbFormlist.Clear
If cmbBooklist = "" Then Exit Sub
Set wkBk = Workbooks(CStr("対象のブック"))
With wkBk.VBProject
For i = 1 To .VBComponents.Count
If .VBComponents(i).Type = 3 Then
コンボボックス.AddItem (.VBComponents(i).name)
End If
Next i
End With
End Sub
'対象のフォームを検索
Private Sub cmbFormlist_Change()
If cmbFormlist = "" Then Exit Sub
If cmbBooklist = "" Then Exit Sub
Dim wkBk As Workbook
Set wkBk = Workbooks(CStr("対象のブック"))
With wkBk.VBProject
For i = 1 To .VBComponents.Count
If .VBComponents(i).Type = 3 And .VBComponents(i).name = CStr("対象のフォーム"
) Then
Range("strNaiyo").Value = FormatVBToPowerShell(wkBk, i)
End If
Next i
End With
End Sub
'検索したフォームを対象のPowershellのフォームに変換
Public Function FormatVBToPowerShell(ByVal wkBk As Workbook, ByVal intVBComponents As Long) As String
Dim strCreateForm As String
Dim strStartUp As String
Dim frmName As String
Dim frmWidth As Double
Dim frmHeight As Double
Dim frmStartUpPosition As Integer
Dim frmCaption As String
Dim frmAdd As String
Dim vbpGet As Object
DoEvents
For Each vbpGet In wkBk.VBProject.VBComponents(intVBComponents).Properties
Select Case vbpGet.name
Case "Width"
frmWidth = vbpGet.Value
Case "Height"
frmHeight = vbpGet.Value
Case "StartUpPosition"
frmStartUpPosition = vbpGet.Value
Case "Caption"
frmCaption = vbpGet.Value
End Select
Next vbpGet
frmName = "$" & wkBk.VBProject.VBComponents(intVBComponents).name
frmAdd = "# フォームにアイテムを追加"
strCreateForm = "# アセンブリのロード"
strCreateForm = strCreateForm & vbCrLf & "Add-Type -AssemblyName System.Windows.Forms"
strCreateForm = strCreateForm & vbCrLf & "# フォームの作成" ' # フォームの作成
strCreateForm = strCreateForm & vbCrLf & frmName & " = New-Object System.Windows.Forms.Form"
strCreateForm = strCreateForm & vbCrLf & frmName & ".Size = """ & PointToPixcel(frmWidth) & "," & PointToPixcel(frmHeight) & """"
Select Case frmStartUpPosition
Case 0 '初期設定値を指定しません。
strStartUp = "Manual" 'フォームの位置が基準、 Location プロパティです。
Case 1 'フォームが属する項目の中央の位置。
strStartUp = "CenterParent" 'フォームがその親フォームの境界内で中央揃えです。
Case 2 '画面全体の中央の位置。
strStartUp = "CenterScreen" 'フォームは、現在の表示の中央に配置されは、フォームのサイズで指定されたディメンションがあります。
Case 3 '画面の左上隅の位置。(vbe .netの違い)
strStartUp = "WindowsDefaultBounds" 'フォームは Windows の既定の場所に配置され、Windows の既定値によって決定境界にします。
'strSet = "WindowsDefaultLocation" 'フォームは、Windows の既定の場所に配置されは、フォームのサイズで指定されたディメンションがあります。
End Select
strCreateForm = strCreateForm & vbCrLf & frmName & ".Startposition = """ & strStartUp & """"
strCreateForm = strCreateForm & vbCrLf & frmName & ".Text = """ & frmCaption & """"
Dim c, buf As String
strCreateForm = strCreateForm & vbCrLf & "# コントロールの作成"
For Each c In wkBk.VBProject.VBComponents(intVBComponents).Designer.Controls
Select Case TypeName(c)
Case "CommandButton"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & " = New-Object System.Windows.Forms.Button"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Location = """ & PointToPixcel(c.Left) & "," & PointToPixcel(c.Top) & """"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Size = """ & PointToPixcel(c.Width) & "," & PointToPixcel(c.Height) & """"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Text = """ & c.Caption & """"
frmAdd = frmAdd & vbCrLf & frmName & ".Controls.Add($" & c.name & ")"
Case "TextBox"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & " = New-Object System.Windows.Forms.TextBox"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Location = """ & PointToPixcel(c.Left) & "," & PointToPixcel(c.Top) & """"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Size = """ & PointToPixcel(c.Width) & "," & PointToPixcel(c.Height) & """"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Text = """ & c.Text & """"
frmAdd = frmAdd & vbCrLf & frmName & ".Controls.Add($" & c.name & ")"
Case "TreeView4"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & " = New-Object System.Windows.Forms.TreeView"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Location = """ & PointToPixcel(c.Left) & "," & PointToPixcel(c.Top) & """"
strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Size = """ & PointToPixcel(c.Width) & "," & PointToPixcel(c.Height) & """"
'strCreateForm = strCreateForm & vbCrLf & "$" & c.name & ".Text = """ & c.Caption & """"
frmAdd = frmAdd & vbCrLf & frmName & ".Controls.Add($" & c.name & ")"
End Select
Next c
strCreateForm = strCreateForm & vbCrLf & frmAdd
strCreateForm = strCreateForm & vbCrLf & "# 最前面に表示：する"
strCreateForm = strCreateForm & vbCrLf & frmName & ".Topmost = $True"
strCreateForm = strCreateForm & vbCrLf & "# フォームを表示"
strCreateForm = strCreateForm & vbCrLf & "$result = " & frmName & ".ShowDialog()"
FormatVBToPowerShell = strCreateForm & vbCrLf & frmAdd
End Function
'ポイントからピクセルに変換
Public Function PointToPixcel(ByVal fltPoint As Double) As Integer
PointToPixcel = fltPoint * 96 / 72
End Function