文章目录
- 前言
- 一、开始VBA编程
- 二、主要代码
- 三、添加到所有EXCEL
- 四、运行效果
- 五、AI扩展
前言
EXCEL右击菜单添加一个选项,点击执行自己逻辑的功能。
然后让DeepSeek帮我把我的想法生成VBA代码
一、开始VBA编程
我的excel主菜单没有’开发工具‘ 选项,
文件 ->选项,打开一下
当然ALT+F11也能打开,就是等会添加“EXCEL加载项”的时候也要使用
然后插入模块
二、主要代码
这里编写测试的是:给选中单元格,添加一个图标和路径,并带连接跳转。的一个功能
2.1、模块1:
' 在标准模块中定义全局变量
Public MyMenuID As String
' 自定义菜单点击事件
Sub MyCustomAction()
'MsgBox "执行自定义逻辑"
'插入文字
'Range("A1").Value = "C:\Desktop\pdf.gif"
Dim rng As Range
On Error Resume Next
Set rng = Selection
'rng.Value = "C:\Desktop\AAA.pdf"
'插入图片
Dim imgPath As String
imgPath = "C:\Desktop\pdf.gif"
ActiveSheet.Shapes.AddPicture _
filename:=imgPath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=rng.Left, _
Top:=rng.Top + 5, _
Width:=16, _
Height:=16
'插入超链接
ActiveSheet.Hyperlinks.Add _
Anchor:=rng, _
Address:="C:\Desktop\AAA.pdf", _
TextToDisplay:="C:\Desktop\AAA.pdf"
'缩进
rng.IndentLevel = 2
'高度
rng.RowHeight = 25
rng.ColumnWidth = 40
'垂直居中
rng.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
End Sub
'添加菜单
Sub AddRightClickMenu()
On Error Resume Next
Dim cmdBar As CommandBar
Dim ctrl As CommandBarControl
MyMenuID = "PDF快捷插入"
Set cmdBar = Application.CommandBars("Cell")
' 先删除已有菜单项防止重复
cmdBar.Controls(MyMenuID).Delete
' 添加新菜单项
Set ctrl = cmdBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With ctrl
.Caption = MyMenuID
.OnAction = "MyCustomAction"
.FaceId = 1001 ' 自定义图标编号
End With
End Sub
'移除菜单
Sub RemoveRightClickMenu()
On Error Resume Next
Application.CommandBars("Cell").Controls(MyMenuID).Delete
End Sub
2.2、ThisWorkbook
Private Sub Workbook_Open()
AddRightClickMenu
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
RemoveRightClickMenu
End Sub
三、添加到所有EXCEL
3.1、保存提示需要启用宏安全设置(建议设为"禁用所有宏,并发出通知")
3.2、好把,搞了半天我保存错了地方。要使每个EXCEL生效就得保存为 .xlam
3.3、再新建一个EXCEL ,把我们写的 添加到加载里
四、运行效果
改好重新打开EXCEL就有了。
要改逻辑,只改我们的.xlam文件就好了。不需要再设置其他了。
更新应该覆盖xlam就行。
嗯,顺便把这图标给一下。找半天没找到,P了一下
五、AI扩展
使用CSDN的AI试试
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True ' 可选显示界面
Set objWorkbook = objExcel.Workbooks.Open("C:\YourExcel.xlsx") ' 替换为实际路径
Set objSheet = objWorkbook.Sheets(1)
Set fso = CreateObject("Scripting.FileSystemObject")
pdfPath = "D:\MyPDF\" ' PDF存储路径
lastRow = objSheet.Cells(objSheet.Rows.Count, "B").End(-4162).Row ' 获取B列最后行号
For i = 2 To lastRow
cellValue = Trim(objSheet.Cells(i, "B").Value)
If cellValue <> "" Then
fullPath = pdfPath & cellValue & ".pdf"
If fso.FileExists(fullPath) Then
Set targetCell = objSheet.Cells(i, "F")
objSheet.Hyperlinks.Add targetCell, fullPath, , , "打开文档"
End If
End If
Next
objWorkbook.Save
objWorkbook.Close
objExcel.Quit
MsgBox "超链接生成完成!"
看起来还是蛮靠谱的。回头稍微改改,丢到MyCustomAction里试试。