ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2130|回复: 9

[求助]向守柔大侠求援

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-6-10 12:30 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

帖子发了几天,好像没有找到好的办法,可能是一个难题,只有求助于守柔大侠了。 我要制作一个Word模板,其中要达到如下目的: 分别用几个工具栏按钮插入不同目录中的图片,与“插入—图片—来自文件”功能差不多,特殊要求是: ①每个按钮对应一个指定文件夹,而不是默认的或上次关闭时的文件夹;各个按钮对应的文件夹不同。 ②最好在打开对话框中不能改变对应位置,如不出现“查找范围”、“文件类型”和工具栏等项目(如图效果)。 如每次点击“结构图”按钮均打开d:\结构图\中的图片;每次点击“装置图”按钮均打开d:\装置图\中的图片。

用VBA能否实现?盼守柔老兄能指点,谢谢了。

[此贴子已经被作者于2005-6-13 1:18:41编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-6-11 20:41 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

自己顶一下

高手们,大侠们:小生这厢有礼了,请不吝赐教。

TA的精华主题

TA的得分主题

发表于 2005-6-12 09:40 | 显示全部楼层
运行一下面的的宏,其他的你自已改一改。

TA的精华主题

TA的得分主题

发表于 2005-6-12 09:49 | 显示全部楼层

你还可以查一查有关:commondialog的用法。这样你的问题就可以全部解决了。

--------------------------------------------------------------------------------------------------------------------

这个可能用有更易的方法。我好象就要能找到了,再努力。

[此贴子已经被作者于2005-6-15 23:18:01编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-6-24 00:42 | 显示全部楼层
第一个问题通过即时修改注册表的办法和插入图片已实现,但第二个问题还未找到好办法。

TA的精华主题

TA的得分主题

发表于 2005-6-24 14:45 | 显示全部楼层

这是一个比较为难的贴子,也许我有些头晕,至今未能很好地找到切入口。

两个方案,供楼主参考:

一是使用运行时间添加控件,并生成"控件数组"(注意此处加了引号)的方式,进行调用,但它对窗体中各个控件的放置要求非常严格,我这只是一个模拟,实际情况中,楼主还要考虑换行和滚动条以及另外的文本框或者标签框等(显示文件/图片名称)

二是使用原有的对话框(图片对话框-Application.Dialogs (wdDialogInsertPicture),每次用户如果其图片路径不对(确定后可以检测)即提示非法路径,然后再回到该Application.Dialogs (wdDialogInsertPicture)对话框来,这个具体我没试,但完全可以做到,这是一个变通的较好的方法.

第一个思路的代码如下,供参考:

'* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-6-24 14:36:33 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [用户窗体-UserForm1]^' '* -----------------------------

Option Explicit Dim ObjLab() As New LabelGpTest '定义数组为新类LabelGpTest Private Sub UserForm_Initialize() Dim aControls As Control, MyPictureFolderPath As String, Apic As String Dim PictCount As Integer, ATop As Single, AHeight As Single, JianJu As Single Dim AWidth As Single, ALeft As Single, ConCount As Integer Dim ctl As Control, LabCount As Integer ATop = 3 '初始顶部位置 ALeft = 3 '初始左边距 AHeight = 15 '每个标签框的高度 AWidth = 20 '每个标签框的宽度 JianJu = 10 '间隔距离 '定义一个文件夹位置,请在此修改路径 MyPictureFolderPath = "C:\Documents and Settings\My Documents\My Pictures\" ChDrive "C" '设置当前驱动器盘符 ChDir MyPictureFolderPath '进入指定目录 Apic = Dir("*.bmp") Do While Apic <> "" '如果是文件夹,或者没有此文件,则会返回"" '在运行时间添加标签框 Set aControls = Me.Controls.Add("Forms.Label.1", , True) With aControls '加载图片 .Picture = LoadPicture(MyPictureFolderPath & Apic) '设置底部距离 .Top = ATop + (ConCount * (JianJu + AHeight)) .Left = ALeft '设置左边距,如果有很多,则要考虑CONCOUNT到多少时换行,并且要考虑滚动条 .Height = AHeight '高度 .Width = AWidth '宽度 '鼠标停留后的提示 .ControlTipText = MyPictureFolderPath & Apic '标题 .Caption = MyPictureFolderPath & Apic End With ConCount = ConCount + 1 Apic = Dir() Loop For Each ctl In Me.Controls '在窗体控件中循环 If ctl.Name Like "Label*" Then '如果为Label LabCount = LabCount + 1 '累加 ReDim Preserve ObjLab(1 To LabCount) '保存并扩容数组 '将该数组成员事件过程赋于该窗体控件 Set ObjLab(LabCount).LabelGroup = Me.Controls(ctl.Name) End If Next '设置窗体的高度 Me.Height = (ConCount + 1) * (JianJu + AHeight) End Sub '---------------------- '* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-6-24 14:36:46 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [类模块-LabelGpTest]^' '* -----------------------------

Public WithEvents LabelGroup As Label Private Sub LabelGroup_Click() ' MsgBox LabelGroup.Caption ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, FileName:=LabelGroup.Caption End Sub '----------------------

qO5xEb7b.zip (17.98 KB, 下载次数: 16)

TA的精华主题

TA的得分主题

发表于 2005-6-24 21:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
第一方案,向老大求解Set aControls = Me.Controls.Add("Forms.Label.1", , True) 中的“("Forms.Label.1" )的意义是什么?运行时我并未看到有图片出现在窗体中。还有这样的方法能否支持PNG格式图片?

第二方案按以下广语句

Options.DefaultFilePath(Path:=wdPicturesPath) = "C:\Documents andSettings\My Documents\My Pictures\" Dialogs(wdDialogInsertPicture).Show 基本解决,但窗口上面的地址栏、向上按钮、查看按钮等没法去掉。

期望守大侠再指导。

[此贴子已经被作者于2005-6-24 23:43:50编辑过]

TA的精华主题

TA的得分主题

发表于 2005-6-25 05:42 | 显示全部楼层
以下是引用dzdoc在2005-6-24 21:29:37的发言: 第一方案,向老大求解Set aControls = Me.Controls.Add("Forms.Label.1", , True) 中的“("Forms.Label.1" )的意义是什么?运行时我并未看到有图片出现在窗体中。还有这样的方法能否支持PNG格式图片?

第二方案按以下广语句

Options.DefaultFilePath(Path:=wdPicturesPath) = "C:\Documents andSettings\My Documents\My Pictures\" Dialogs(wdDialogInsertPicture).Show 基本解决,但窗口上面的地址栏、向上按钮、查看按钮等没法去掉。

期望守大侠再指导。

第一个问题,其实楼主应该发挥主观能动性,既然守柔都已经把代码完成了,你难道查一下帮助不行吗?我已经说了,这是一个运行时间创建控件的方法,是什么控件呢,在示例中,是LABEL(标签框)控件,"Forms.Label.1"就是标签框控件的程序设计标识符 (ProgID) ,VBA以此来创建该对象.

至于你说没有出现图片,那是你没有改变路径,你改一个有图片的路径嘛,对不对?

'定义一个文件夹位置,请在此修改路径

MyPictureFolderPath = "C:\Documents and Settings\My Documents\My Pictures\" 这不是在代码中已经写得很清楚了吗?

至于需要使用其它形式的图片格式,你可以在DIR中修改:Apic = Dir("*.bmp"),这是任意BMP文件,当然你可以改为"*.GIF",但你得注意,LABEL的PICTRUE方法是否支持.

关于" 基本解决,但窗口上面的地址栏、向上按钮、查看按钮等没法去掉。"这个问题,我本不想多说什么,我目前没有能力对APPLICATION.DIALOGS(**)进行改造,我想,目前也没有人对此能进行改造,至少我可能孤陋寡闻了.我说了,是变通的方法,我们的目的,是不让用户介入其它路径的图片向指定的文档插入图片,而不是要禁止所有的OFFICE深层对话框,我想,dzdoc你不会连WINDOWS的复制粘贴都想禁了吧,为什么?因为用户可以通查找任意图片向文档粘贴吧,这我可不行了,我闪,请另请高明;关于图片格式问题,其实,我们直接可以使用APPLICATION.FILEDIALOG对象,通过文件筛选器,取得指定的文件对象,然后根据返回的地址,向文档中插入图片.(有关APPLICAITON.FILEDIALOG对象的应用,在代码集中有)

归根结底,VBA是面向对象的一个编程语言,用户在使用它完成指定工作时,要考虑对象的实际情况,不能一昧追求外观而忽视实现价值,也许使用API可以更改这个对话框,然而,你又有多大意义呢?也许你可以实现,但你耗费的精力远大于整个程序的其它时间,有必要吗?(能不能做是一回事,做成的对于VBA程序的有效性是一回事,当然,我不会做)

此话题,我到此为止.

TA的精华主题

TA的得分主题

发表于 2005-6-25 12:05 | 显示全部楼层

其实第一问题中关于图片不能显示的原因我也分析了,而且更改了相应的路径该路径中有一此图片为BMP格式,但还是没有相应显示。

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-6-27 12:51 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

感谢守版主

非常感谢守版主。其实,版主的解决方案使用起来很好,另一些要求是近乎无理了,主要是在有一个软件中看到了我认为是类似的东西,想再完美一些。是的,“不会连WINDOWS的复制粘贴都想禁了吧”,大概“无知而无畏”,我原来还真以为是可以的,哈哈

另外,编程我基本是外行,主要是dzdoc朋友的指导,一些无理要求是我向他提出来的。

再次感谢守版主不厌其烦的指导。

[此贴子已经被作者于2005-6-27 12:52:49编辑过]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-15 07:44 , Processed in 0.044271 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表