求助各位大神如何提取图形作为模板

syaoraney

各位大神
如何通过插件手动提取C列的图形作为模板，然后点击生成能得到F列的结果？

守候_CJ

VBA窗体操作Excel形状示例

代码

1. Sub 窗体初始化()
   
2.     Dim sp As Shape
   
3.     Dim i As Integer
   
4.    
   
5.     '移除原有选项
   
6.     For i = Me.图形列表.ListCount - 1 To 0 Step -1
   
7.         Me.图形列表.RemoveItem i
   
8.     Next
   
9.    
   
10.     '添加新选项
    
11.     For i = 1 To ThisWorkbook.Sheets("sheet1").Shapes.Count
    
12.         Set sp = ThisWorkbook.Sheets("sheet1").Shapes(i)
    
13.         Me.图形列表.AddItem sp.Name
    
14.     Next
    
15.     Me.图形列表.Style = fmStyleDropDownList
    
16.     Me.图形列表.Text = Me.图形列表.List(0, 0)
    
17.    
    
18.     Set sp = Nothing
    
19. End Sub
    
20. 
    
21. Sub 生成结果()
    
22.     Dim i As Long
    
23.     Dim sht As Worksheet
    
24.     Dim sp As Shape
    
25.    
    
26.     Set sht = ThisWorkbook.Sheets("sheet1")
    
27.     sht.Shapes(Me.图形列表.Text).Copy
    
28.    
    
29.     i = 2
    
30.     Do While sht.Range("a" & i).Value <> ""
    
31.         复制图形并赋值 Me.图形列表.Text, sht.Range("e" & i), sht.Range("a" & i).Value
    
32.         i = i + 1
    
33.     Loop
    
34.    
    
35.     Set sht = Nothing
    
36.     Set sp = Nothing
    
37. End Sub
    
38. Sub 复制图形并赋值(shapeName As Variant, Rng As Range, spText)
    
39.     ActiveSheet.Shapes.Range(Array(shapeName)).Select
    
40.     Selection.Copy
    
41.     Range(Rng.Cells(1).Address).Select
    
42.     Rng.Worksheet.Paste
    
43.     Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = CStr(spText)
    
44. End Sub
    
45. 
    
46. Private Sub CommandButton1_Click()
    
47.     生成结果
    
48. End Sub
    
49. 
    
50. Private Sub UserForm_Initialize()
    
51.     窗体初始化
    
52. End Sub
    
53. 
    
54. Private Sub 图形列表_Change()
    
55.     ThisWorkbook.Sheets("Sheet1").Shapes(Me.图形列表.Text).Select
    
56. End Sub

复制代码