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

864163213 · 发表于 2021-6-22 12:52

本帖最后由 864163213 于 2021-6-22 13:04 编辑

复制代码

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

实现效果1

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

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

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

Private Sub addwin()
Dim MyControl As MyTask = New MyTask
WritR.Checked = True
ischeck = True
Try
TaskPaneShared.MyPane = Globals.ThisAddIn.CustomTaskPanes.Add(MyControl, "--")
TaskPaneShared.MyPane.DockPosition = Microsoft.Office.Core.MsoCTPDockPosition.msoCTPDockPositionRight
TaskPaneShared.MyPane.Width = 600
TaskPaneShared.MyPane.Visible = True
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub

复制代码

任务窗格代码如下：

Imports System.Windows.Forms
Public Class MyTask
Private xlApp As Excel.Application
Dim Tr As TreeView
Dim Lb As ListBox
Dim xlDa As TaskData
Public WriteRow As Boolean
Private Shared MT As MyTask
Private Shared ReadOnly _Lock As Object = New Object
Public Shared Function GetInstance() As MyTask
If IsNothing(MT) Then
SyncLock _Lock
If IsNothing(MT) Then
MT = New MyTask
End If
End SyncLock
End If
Return MT
End Function
Private Sub MyTask_Load(sender As Object, e As EventArgs) Handles Me.Load
xlApp = Globals.ThisAddIn.Application
Lb = Me.ListBox1
Tr = Me.TreeView1
addTr2()
xlApp.ScreenUpdating = True
addlb("备注信息,价格")
End Sub
Public Sub addTr2()
TreeView1.Nodes.Clear()
xlDa = New TaskData()
Dim Top_LS() As String = xlDa.Top_LS.ToArray
For i = 0 To Top_LS.GetUpperBound(0)
If Trim(Top_LS(i)) = "" Then Continue For
Dim k As Integer = TreeView1.Nodes.Add(New TreeNode(Top_LS(i))) '第一级
Dim Tr As TreeNode = TreeView1.Nodes(k)
AddTreenode(Tr, Top_LS(i))
Next
End Sub
''' <summary>
''' 递归树状图
''' </summary>
''' <param name="Tr">节点</param>
''' <param name="key">上级</param>
Private Sub AddTreenode(Tr As TreeNode, key As String)
If xlDa.OtherCls.ContainsKey(key) Then
Dim items() As String = xlDa.OtherCls(key).ToArray
For z = 0 To items.GetUpperBound(0) '同级
Dim i As Integer = Tr.Nodes.Add(New TreeNode(items(z)))
Dim item As String = Tr.Nodes(i).Text
If Trim(item) <> "" Then '查是否有下一级
Dim NewTr As TreeNode = Tr.Nodes(i)
Dim NewKey As String = key & item
AddTreenode(NewTr, NewKey)
End If
Next
End If
End Sub
Private Sub addlb(li As String)
Dim mLv() As String = li.Split(Chr(44))
Lb.Items.Clear()
If IsNothing(mLv) OrElse mLv.Length < 1 Then Return
For Each item As String In mLv
Lb.Items.Add(item)
Next
End Sub
Private Sub TreeView1_NodeMouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeNodeMouseClickEventArgs) Handles TreeView1.NodeMouseClick
Lb.Items.Clear()
Dim index As TreeNode = Tr.SelectedNode
If IsNothing(index) Then Return
Dim s As String = index.Text
If xlDa.Noteinfo.ContainsKey(s) Then
Lb.Items.AddRange(xlDa.Noteinfo(s))
End If
End Sub
Private Sub ListBox1_DoubleClick(sender As Object, e As EventArgs) Handles ListBox1.DoubleClick
Dim index As Integer = Lb.SelectedIndex
If IsNothing(index) Then Return
Dim s As String = Lb.Items(index).ToString
TextBox1.Clear()
TextBox1.Text = Lb.Items(Lb.SelectedIndex).ToString
'Clipboard.SetDataObject(Lb.Items(index))
'MessageBox.Show("内容已经复制完毕")
End Sub
Dim b As Boolean
Private Sub TreeView1_DoubleClick(sender As Object, e As EventArgs) Handles TreeView1.DoubleClick
Lb.Items.Clear()
Dim xlApp As Excel.Application = Globals.ThisAddIn.Application
Dim index1 As TreeNode
Dim index0 As TreeNode
Dim index As TreeNode = Tr.SelectedNode
If IsNothing(index) Then Return
Dim Val As String = index.Text
Dim str As String = xlApp.ActiveCell.Address
Dim C As String = str.Substring(1, 1)
Dim R As Integer = CInt(str.Substring(3))
If WenKong.ischeck Then
If str.Contains(Chr(44)) Or str.Contains(":") Then
MessageBox.Show("请选择单个表格")
Return
End If
If R < 6 Then Return
If index.Level = 3 Then
index1 = index.Parent
index0 = index1.Parent
Dim index01 As TreeNode = index0.Parent
xlCellWrite({index0.Text, index1.Text, index.Text, index01.Text}, R)
End If
Else
xlApp.ActiveCell.Value = Val
End If
xlApp.Range(C & (R + 1)).Select()
xlApp = Nothing
b = True
End Sub
Private Sub xlCellWrite(v() As String, R As Integer)
If IsNothing(v) Then Return
xlApp = Globals.ThisAddIn.Application
xlApp.Cells(R, CellAdress.Cadress.Main).Value = v(0)
xlApp.Cells(R, CellAdress.Cadress.Brand).Value = v(1)
xlApp.Cells(R, CellAdress.Cadress.Spec).Value = v(2)
xlApp.Cells(R, CellAdress.Cadress.Topclassify).Value = v(3)
If xlDa.Unit.ContainsKey(v(0) & v(1) & v(2)) Then
xlApp.Cells(R, CellAdress.Cadress.unit).Value = xlDa.Unit(v(0) & v(1) & v(2))
End If
End Sub
Private Sub TreeView1_BeforeCollapse(sender As Object, e As TreeViewCancelEventArgs) Handles TreeView1.BeforeCollapse
If b Then
e.Cancel = True
End If
b = False
End Sub
Private Sub Btn_Ex_Click(sender As Object, e As EventArgs) Handles Btn_Ex.Click
TreeView1.ExpandAll()
End Sub
Private Sub Btn_C_Click(sender As Object, e As EventArgs) Handles Btn_C.Click
TreeView1.CollapseAll()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim val As String = UCase(M_name.Text)
Dim val2 As String = UCase(M_brand.Text)
Dim val3 As String = UCase(M_supply.Text)
DGV1.Rows.Clear()
If IsNothing(xlDa.SearcgDic) Then xlDa = New TaskData()
For Each Str As String In xlDa.SearcgDic.Keys
If Str.ToUpper.Contains(val) Then
If Str.ToUpper.Contains(val) Then
If Str.ToUpper.Contains(val2) Then
DGV1.Rows.Add(xlDa.SearcgDic(Str))
End If
End If
End If
Next
End Sub
End Class

复制代码

02761752696 · 发表于 2021-6-22 13:44

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

mohao · 发表于 2021-6-23 15:30

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

864163213 · 发表于 2021-6-23 16:13

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

已回复
参考下面

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

复制代码

864163213 · 发表于 2021-6-23 16:28

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

刚好作为一个实例

864163213 · 发表于 2021-6-23 16:36

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

回复了，你看看

刚好作为一个实例

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

复制代码

mohao · 发表于 2021-6-25 13:49

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

刚好作为一个实例

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

		自动登录	找回密码
密码			免费注册

[原创] 使用VSTO进行BOM快速录入功能的实现

评分

最新热点 /1