使用VSTO进行BOM快速录入功能的实现

864163213

1. 
   

复制代码

     主要由以上几方面组成来实现          1 excel 任务窗格 外接应用程序
      2 用户控件
      3 数据库
   
    实现效果1

        表格内快速写入物料信息
   实现方式：

   把所有系统物料绑定用户控件TREE，通过双击即可把对应的物料的型号，厂家，编码写到当前BOM表内

以使工程无需从其它地方查找；由到数据都从数据库读取，不管外网内网均可以同步读取
控件的点击事件代码如下：

1. Private Sub addwin()
   
2.         Dim MyControl As MyTask = New MyTask
   
3.         WritR.Checked = True
   
4.         ischeck = True
   
5. 
   
6.         Try
   
7.             TaskPaneShared.MyPane = Globals.ThisAddIn.CustomTaskPanes.Add(MyControl, "--")
   
8.             TaskPaneShared.MyPane.DockPosition = Microsoft.Office.Core.MsoCTPDockPosition.msoCTPDockPositionRight
   
9.             TaskPaneShared.MyPane.Width = 600
   
10.             TaskPaneShared.MyPane.Visible = True
    
11.         Catch ex As Exception
    
12.             MessageBox.Show(ex.Message)
    
13.         End Try
    
14. 
    
15.     End Sub

复制代码

任务窗格代码如下：

1. Imports System.Windows.Forms
   
2. 
   
3. Public Class MyTask
   
4.     Private xlApp As Excel.Application
   
5.     Dim Tr As TreeView
   
6.     Dim Lb As ListBox
   
7.     Dim xlDa As TaskData
   
8.     Public WriteRow As Boolean
   
9.     Private Shared MT As MyTask
   
10.     Private Shared ReadOnly _Lock As Object = New Object
    
11. 
    
12. 
    
13.     Public Shared Function GetInstance() As MyTask
    
14.         If IsNothing(MT) Then
    
15.             SyncLock _Lock
    
16.                 If IsNothing(MT) Then
    
17.                     MT = New MyTask
    
18.                 End If
    
19. 
    
20.             End SyncLock
    
21.         End If
    
22.         Return MT
    
23.     End Function
    
24. 
    
25.     Private Sub MyTask_Load(sender As Object, e As EventArgs) Handles Me.Load
    
26.         xlApp = Globals.ThisAddIn.Application
    
27.         Lb = Me.ListBox1
    
28.         Tr = Me.TreeView1
    
29.         addTr2()
    
30.         xlApp.ScreenUpdating = True
    
31.         addlb("备注信息,价格")
    
32.     End Sub
    
33. 
    
34.     Public Sub addTr2()
    
35.         TreeView1.Nodes.Clear()
    
36.         xlDa = New TaskData()
    
37.         Dim Top_LS() As String = xlDa.Top_LS.ToArray
    
38.         For i = 0 To Top_LS.GetUpperBound(0)
    
39.             If Trim(Top_LS(i)) = "" Then Continue For
    
40.             Dim k As Integer = TreeView1.Nodes.Add(New TreeNode(Top_LS(i))) '第一级
    
41.             Dim Tr As TreeNode = TreeView1.Nodes(k)
    
42.             AddTreenode(Tr, Top_LS(i))
    
43.         Next
    
44.       
    
45.     End Sub
    
46.     ''' <summary>
    
47.     ''' 递归树状图
    
48.     ''' </summary>
    
49.     ''' <param name="Tr">节点</param>
    
50.     ''' <param name="key">上级</param>
    
51.     Private Sub AddTreenode(Tr As TreeNode, key As String)
    
52.         If xlDa.OtherCls.ContainsKey(key) Then
    
53.             Dim items() As String = xlDa.OtherCls(key).ToArray
    
54.             For z = 0 To items.GetUpperBound(0) '同级
    
55.                 Dim i As Integer = Tr.Nodes.Add(New TreeNode(items(z)))
    
56.                 Dim item As String = Tr.Nodes(i).Text
    
57.                 If Trim(item) <> "" Then '查是否有下一级
    
58.                     Dim NewTr As TreeNode = Tr.Nodes(i)
    
59.                     Dim NewKey As String = key & item
    
60.                     AddTreenode(NewTr, NewKey)
    
61.                 End If
    
62.             Next
    
63.         End If
    
64.     End Sub
    
65.     Private Sub addlb(li As String)
    
66.         Dim mLv() As String = li.Split(Chr(44))
    
67.         Lb.Items.Clear()
    
68.         If IsNothing(mLv) OrElse mLv.Length < 1 Then Return
    
69.         For Each item As String In mLv
    
70.             Lb.Items.Add(item)
    
71.         Next
    
72.     End Sub
    
73. 
    
74.     Private Sub TreeView1_NodeMouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeNodeMouseClickEventArgs) Handles TreeView1.NodeMouseClick
    
75.         Lb.Items.Clear()
    
76.         Dim index As TreeNode = Tr.SelectedNode
    
77.         If IsNothing(index) Then Return
    
78.         Dim s As String = index.Text
    
79.         If xlDa.Noteinfo.ContainsKey(s) Then
    
80.             Lb.Items.AddRange(xlDa.Noteinfo(s))
    
81.         End If
    
82.     End Sub
    
83. 
    
84.     Private Sub ListBox1_DoubleClick(sender As Object, e As EventArgs) Handles ListBox1.DoubleClick
    
85.         Dim index As Integer = Lb.SelectedIndex
    
86.         If IsNothing(index) Then Return
    
87.         Dim s As String = Lb.Items(index).ToString
    
88.         TextBox1.Clear()
    
89.         TextBox1.Text = Lb.Items(Lb.SelectedIndex).ToString
    
90.         'Clipboard.SetDataObject(Lb.Items(index))
    
91. 
    
92.         'MessageBox.Show("内容已经复制完毕")
    
93.     End Sub
    
94.     Dim b As Boolean
    
95.     Private Sub TreeView1_DoubleClick(sender As Object, e As EventArgs) Handles TreeView1.DoubleClick
    
96.         Lb.Items.Clear()
    
97.         Dim xlApp As Excel.Application = Globals.ThisAddIn.Application
    
98.         Dim index1 As TreeNode
    
99.         Dim index0 As TreeNode
    
100.         Dim index As TreeNode = Tr.SelectedNode
     
101.         If IsNothing(index) Then Return
     
102.         Dim Val As String = index.Text
     
103.         Dim str As String = xlApp.ActiveCell.Address
     
104.         Dim C As String = str.Substring(1, 1)
     
105.         Dim R As Integer = CInt(str.Substring(3))
     
106.         If WenKong.ischeck Then
     
107. 
     
108.             If str.Contains(Chr(44)) Or str.Contains(":") Then
     
109.                 MessageBox.Show("请选择单个表格")
     
110.                 Return
     
111.             End If
     
112.             If R < 6 Then Return
     
113.             If index.Level = 3 Then
     
114.                 index1 = index.Parent
     
115.                 index0 = index1.Parent
     
116.                 Dim index01 As TreeNode = index0.Parent
     
117.                 xlCellWrite({index0.Text, index1.Text, index.Text, index01.Text}, R)
     
118.             End If
     
119.         Else
     
120.             xlApp.ActiveCell.Value = Val
     
121.         End If
     
122.         xlApp.Range(C & (R + 1)).Select()
     
123.         xlApp = Nothing
     
124.         b = True
     
125.     End Sub
     
126.     Private Sub xlCellWrite(v() As String, R As Integer)
     
127.         If IsNothing(v) Then Return
     
128.         xlApp = Globals.ThisAddIn.Application
     
129.         xlApp.Cells(R, CellAdress.Cadress.Main).Value = v(0)
     
130.         xlApp.Cells(R, CellAdress.Cadress.Brand).Value = v(1)
     
131.         xlApp.Cells(R, CellAdress.Cadress.Spec).Value = v(2)
     
132.         xlApp.Cells(R, CellAdress.Cadress.Topclassify).Value = v(3)
     
133.         If xlDa.Unit.ContainsKey(v(0) & v(1) & v(2)) Then
     
134.             xlApp.Cells(R, CellAdress.Cadress.unit).Value = xlDa.Unit(v(0) & v(1) & v(2))
     
135.         End If
     
136.     End Sub
     
137.     Private Sub TreeView1_BeforeCollapse(sender As Object, e As TreeViewCancelEventArgs) Handles TreeView1.BeforeCollapse
     
138.         If b Then
     
139.             e.Cancel = True
     
140.         End If
     
141.         b = False
     
142.     End Sub
     
143.     Private Sub Btn_Ex_Click(sender As Object, e As EventArgs) Handles Btn_Ex.Click
     
144.         TreeView1.ExpandAll()
     
145.     End Sub
     
146.     Private Sub Btn_C_Click(sender As Object, e As EventArgs) Handles Btn_C.Click
     
147.         TreeView1.CollapseAll()
     
148.     End Sub
     
149. 
     
150.     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
     
151.         Dim val As String = UCase(M_name.Text)
     
152.         Dim val2 As String = UCase(M_brand.Text)
     
153.         Dim val3 As String = UCase(M_supply.Text)
     
154.         DGV1.Rows.Clear()
     
155.         If IsNothing(xlDa.SearcgDic) Then xlDa = New TaskData()
     
156.         For Each Str As String In xlDa.SearcgDic.Keys
     
157.             If Str.ToUpper.Contains(val) Then
     
158.                 If Str.ToUpper.Contains(val) Then
     
159.                     If Str.ToUpper.Contains(val2) Then
     
160.                         DGV1.Rows.Add(xlDa.SearcgDic(Str))
     
161.                     End If
     
162.                 End If
     
163.             End If
     
164.         Next
     
165.     End Sub
     
166. 
     
167. 
     
168. End Class

复制代码

02761752696

厉害    有实例文件学习下更好

mohao

请问可以帮我看看这个VSTO代码怎么解决吗？
http://club.excelhome.net/thread-1589522-1-1.html

864163213

mohao 发表于 2021-6-23 15:30
请问可以帮我看看这个VSTO代码怎么解决吗？
http://club.excelhome.net/thread-1589522-1-1.html

已回复
参考下面

1. Dim objPPT As Microsoft.Office.Interop.PowerPoint.Application
   
2.         Dim wb As Excel.Workbook = CType(Globals.ThisAddIn.Application.ActiveWorkbook, Excel.Workbook)
   
3.         Dim pth As String = wb.Path & "\自动报表.pptx"
   
4.         objPrs = objPPT.Presentations.Open(pth, , , msoFalse)

复制代码

864163213

mohao 发表于 2021-6-23 15:30
请问可以帮我看看这个VSTO代码怎么解决吗？
http://club.excelhome.net/thread-1589522-1-1.html

刚好作为一个实例

864163213

mohao 发表于 2021-6-23 15:30
请问可以帮我看看这个VSTO代码怎么解决吗？
http://club.excelhome.net/thread-1589522-1-1.html

回复了，你看看

刚好作为一个实例

1. Dim objPPT As Microsoft.Office.Interop.PowerPoint.Application
   
2.         objPPT = New Microsoft.Office.Interop.PowerPoint.Application
   
3.         Dim wb As Excel.Workbook = CType(Globals.ThisAddIn.Application.ActiveWorkbook, Excel.Workbook)
   
4.         Dim pth As String = wb.Path & "\自动报表.pptx"
   
5.         objPrs = objPPT.Presentations.Open(pth, , , msoFalse)

复制代码

mohao

864163213 发表于 2021-6-23 16:36
回复了，你看看

刚好作为一个实例

谢谢，现在EXCEL的图表怎么更新到PPT里我大致学会了一点，请问一个，在WORD文档里，有表格、文字，那么应该怎么能自动更新的PPT里呢？能不能也做一个VSTO的实例出来？