[已解决]execl 在输入需要参数后，直接调用 vba，可以吗？

scz467

1. Sub insertPic()
   
2. '
   
3. '删除已有图片
   
4.     Dim S1 As Shape '声明变量 as后 变量类型
   
5.     'Dim RG As Range
   
6.     For Each S1 In ActiveSheet.Shapes 'ActiveSheet 代表活动工作簿中的，或者指定的窗口或工作簿中的活动工作表（最上面的工作表）。
   
7.       If S1.Type <> 8 Then 'type属性返回图表类型
   
8.         S1.Delete
   
9.       End If
   
10.     Next S1
    
11. '插入图片
    
12.     imgWidth = InputBox("请输入一个，大于等于1 数字", "设置插入图片列的宽度", 20)
    
13. imgHeight = InputBox("请输入一个，大于等于1 数字", "设置插入图片行的高度", 40)
    
14. hColumn = InputBox("请输入图片插入的列数", "设置插入图片行的高度(大于等于 1 的整数)", 11)
    
15.    
    
16.    
    
17.     If hColumn <> "" And imgWidth <> "" And imgHeight <> "" Then
    
18.         'Fix 函数返回参数的整数部分
    
19.         If IsNumeric(hColumn) = True And IsNumeric(imgWidth) = True And IsNumeric(imgHeight) = True And hColumn - Fix(hColumn) = 0 And hColumn > 0 And imgWidth >= 1 And imgHeight >= 1 Then
    
20.             imgWidth = CDbl(imgWidth)
    
21.             imgHeight = CDbl(imgHeight)
    
22.             hColumn = CInt(hColumn)
    
23.             Dim i As Integer
    
24.             Dim FilPath As String
    
25.             Dim rng As Range
    
26.             Dim S As String
    
27.             S = ""
    
28.             With Sheet1
    
29.                 For i = 2 To .Range("a65536").End(xlUp).Row '查找A列从65536位置的单元格起，向上查找，直到找到最后一个非空单元格为止，并显示其行号
    
30.                     If Trim(Cells(i, 1).Text) <> "" Then
    
31.                         FilPath = ThisWorkbook.Path & "\photos" & .Cells(i, 1).Text & ".jpg"
    
32.                         'FilPath = "D:\vba\vbatest\photos" & .Cells(i, 1).Text & ".jpg"
    
33.                         If Dir(FilPath) <> "" Then
    
34.                            
    
35.                            .Pictures.Insert(FilPath).Select '选中
    
36.                             Set rng = .Cells(i, hColumn)
    
37.                             With Selection  '当前的选择对象
    
38.                                 ActiveSheet.Rows(i).RowHeight = imgHeight '调整行高适合图片大小 Selection.ShapeRange.Height * imgHeight
    
39.                                 'MsgBox ActiveSheet.Rows(i).RowHeight
    
40.                                 ActiveSheet.Columns(hColumn).ColumnWidth = imgWidth '粗略调整列宽适合图片大小 Selection.ShapeRange.Width * imgWidth
    
41.                                 .Top = rng.Top + 1
    
42.                                 .Left = rng.Left + 2
    
43.                                 .Width = rng.Width
    
44.                                 .Height = rng.Height
    
45.                             End With
    
46.                         Else
    
47.                             S = S & Chr(10) & .Cells(i, 1).Text
    
48.                         End If
    
49.                     End If
    
50.                 Next
    
51.                 .Cells(hColumn, i).Select
    
52.             End With
    
53.             If S <> "" Then
    
54.                 MsgBox S & Chr(10) & "没有照片"
    
55.             End If
    
56.         Else
    
57.             MsgBox "输入有误"
    
58.         End If
    
59.     End If
    
60. End Sub
    

复制代码

现在是想在打开 execl 后直接在里面输入参数，而不需要点击 “插入图片” 根据 inputbox 的输入参数来执行？

不知道没有这样的效果

最佳答案

月排行榜 / 总排行榜

suye1010

2013-2-20 19:02

修改以下的几句代码,把=后的内容改为你存放参数的单元格即可,譬如imgWidth=range("A1")
imgWidth = InputBox("请输入一个，大于等于1 数字", "设置插入图片列的宽度", 20)
imgHeight = InputBox("请输入一个，大于等于1 数字", "设置插入图片行的高度", 40)
hColumn = InputBox("请输入图片插入的列数", "设置插入图片行的高度(大于等于 1 的整数)", 11)

跳转到最佳答案楼层

suye1010

修改以下的几句代码,把=后的内容改为你存放参数的单元格即可,譬如imgWidth=range("A1")
imgWidth = InputBox("请输入一个，大于等于1 数字", "设置插入图片列的宽度", 20)
imgHeight = InputBox("请输入一个，大于等于1 数字", "设置插入图片行的高度", 40)
hColumn = InputBox("请输入图片插入的列数", "设置插入图片行的高度(大于等于 1 的整数)", 11)

无聊的疯子

直接使用 Change 事件,固定在 A列 就可以了!!

scz467

suye1010 发表于 2013-2-20 19:02
修改以下的几句代码,把=后的内容改为你存放参数的单元格即可,譬如imgWidth=range("A1")
imgWidth = InputB ...

灰常感谢 哈哈

scz467

suye1010 发表于 2013-2-20 19:02
修改以下的几句代码,把=后的内容改为你存放参数的单元格即可,譬如imgWidth=range("A1")
imgWidth = InputB ...

在否，问一个 就在上文的代码中，删除图片是删除的所有的图片，现在想删除插入列的图片，可有办法删除吗？