[已解决]求助：模拟插入对话框：把插入图片对话框的“插入”功能改成“”复制功能

事后诸葛亮 · 发表于 2013-5-2 11:33

本帖最后由事后诸葛亮于 2013-5-2 11:34 编辑

QQ截图20130502112900.jpg

上图是在EXCEL中插入图片功能时所显示的窗口。

我想：
用VBA模拟出一个插入图片(或文件)的窗口来,
当我选择了照片时，文件名称栏自动填充。
点击 “插入” 按钮时，执行复制动作，把所选择的照片，复制到“C：\照片”目录下。
谢谢了。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-2 12:38

Sub 按钮1_Click()
Dim srcFile$, DstFile$
Dim strDstPath$
strDstPath = "C:\照片"
On Error GoTo ErrorCheck:
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "图像文件", "*.jpeg;*.jpg;*.png"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
srcFile = .SelectedItems(1)
DstFile = Mid(srcFile, InStrRev(srcFile, "") + 1)
DstFile = Left(DstFile, InStrRev(DstFile, ".") - 1) & "-复制" & Mid(DstFile, InStrRev(DstFile, "."))
Range("a1").Value = srcFile
FileCopy srcFile, strDstPath & DstFile
MsgBox "源文件：" & srcFile & vbCrLf & vbCrLf & _
"目标文件：" & strDstPath & DstFile, vbInformation
Exit Sub
End If
End With
ErrorCheck:
MsgBox Err.Number & vbCrLf & _
Err.Description, vbCritical
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2013-5-2 11:34

代码中调用一个打开对话框，再对文件做复制操作。

事后诸葛亮 · 发表于 2013-5-2 11:35

hwc2ycy 发表于 2013-5-2 11:34
代码中调用一个打开对话框，再对文件做复制操作。

原理明白，不会写代码呀。我目前的水平是大体可以看明白代码，也能简单修改，但自己写水平不够。
请帮忙给写一下吧，谢谢了。

hwc2ycy · 发表于 2013-5-2 11:44

本帖最后由 hwc2ycy 于 2013-5-2 11:46 编辑

Dim srcFile$, DstFile$
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "图像文件", "*.jpeg;*.jpg;*.png"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
srcFile = .SelectedItems(1)
DstFile = Mid(srcFile, InStrRev(srcFile, "") + 1)
FileCopy srcfile, "C：\照片" & DstFile
End If
End With

复制代码

hwc2ycy · 发表于 2013-5-2 11:46

本帖最后由 hwc2ycy 于 2013-5-2 11:51 编辑

Dim srcFile$, DstFile$
On Error GoTo ErrorCheck:
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "图像文件", "*.jpeg;*.jpg;*.png"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
srcFile = .SelectedItems(1)
DstFile = Mid(srcFile, InStrRev(srcFile, "") + 1)
FileCopy srcFile, "C:\照片" & DstFile
MsgBox srcFile & " 复制完成"
Exit Sub
End If
End With
ErrorCheck:
MsgBox Err.Number & vbCrLf & _
Err.Description, vbCritical

复制代码

hwc2ycy · 发表于 2013-5-2 11:50

在WIN7下，小心会有文件权限的问题。
上面冒号有误。

Sub 按钮1_Click()
Dim srcFile$, DstFile$
On Error GoTo ErrorCheck:
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "图像文件", "*.jpeg;*.jpg;*.png"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
srcFile = .SelectedItems(1)
DstFile = Mid(srcFile, InStrRev(srcFile, "") + 1)
FileCopy srcFile, "c:\照片" & DstFile
MsgBox srcFile & " 复制完成"
Exit Sub
End If
End With
ErrorCheck:
MsgBox Err.Number & vbCrLf & _
Err.Description, vbCritical
End Sub

复制代码

hwc2ycy · 发表于 2013-5-2 11:53

原来还担心文件名中空格的问题，测试，没问题。

事后诸葛亮 · 发表于 2013-5-2 12:05

hwc2ycy 发表于 2013-5-2 11:50
在WIN7下，小心会有文件权限的问题。
上面冒号有误。

谢谢，完美运行。

提高点：
问题1：我如何将该文件名同时输入 range("A1")单元格呢。文件名怎么表示？带格式的文件名和不带格式的文件名各怎么表示？。

问题2：我如何重命名呢？就是把“照片1.jpg”复制到“C：\照片”后，成为“照片1-复制.jpg”呢？
并且把“照片1-复制.jpg”文件名同时输入 range("A1")单元格，带格式的文件名和不带格式的文件名各怎么表示？

两个问题能否分别给我解决一下，因为我这次碰到你这个高手了，我想在解决问题的情况下，进一步学习一下。谢谢你了。[em27]

hwc2ycy · 发表于 2013-5-2 12:38

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub 按钮1_Click()
Dim srcFile$, DstFile$
Dim strDstPath$
strDstPath = "C:\照片"
On Error GoTo ErrorCheck:
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "图像文件", "*.jpeg;*.jpg;*.png"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
srcFile = .SelectedItems(1)
DstFile = Mid(srcFile, InStrRev(srcFile, "") + 1)
DstFile = Left(DstFile, InStrRev(DstFile, ".") - 1) & "-复制" & Mid(DstFile, InStrRev(DstFile, "."))
Range("a1").Value = srcFile
FileCopy srcFile, strDstPath & DstFile
MsgBox "源文件：" & srcFile & vbCrLf & vbCrLf & _
"目标文件：" & strDstPath & DstFile, vbInformation
Exit Sub
End If
End With
ErrorCheck:
MsgBox Err.Number & vbCrLf & _
Err.Description, vbCritical
End Sub

复制代码

事后诸葛亮 · 发表于 2013-5-2 13:54

hwc2ycy 发表于 2013-5-2 12:38

谢谢，高手。谢谢了。基本看明白了。我再细研究一下。呵呵

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

[已解决]求助：模拟插入对话框：把插入图片对话框的“插入”功能改成“”复制功能

评分