vba调用摄像头并将摄像头图像如何保存本地磁盘并保存到指定SHEET的单元格里?

Sub SaveFrame()
Dim FileName As String

Dim retVal As Boolean

FileName = Environ("temp") & "\test.bmp"
retVal = capFileSaveDIB(hCapWnd, FileName)

With ActiveSheet.Pictures.Insert(FileName)
   If ActiveCell.Width > x Then .Left = ActiveCell.Left + (ActiveCell.Width - x) / 2 Else .Left = ActiveCell.Left
    If ActiveCell.Height > y Then .Top = ActiveCell.Top + (ActiveCell.Height - y) / 2 Else .Top = ActiveCell.Top
    .Height = y
    .Width = x
End With
Kill FileName

End Sub

这段代码只能将摄像头捕捉的图片保存到当前活动工作表的当前单元格,现在想保存到磁盘指定位置并保存到其他工作表的指定位置,这段代码怎么改?

保存到磁盘自定位置修改filename变量,要不 Environ("temp")是系统临时文件保存路径,而且kill filename那句去掉,会删除文件。

还有x,y在哪定义的?插入到其他sheet中用worksheets获取对应的sheet后插入就行了。代码如下

img



Sub SaveFrame()

x = y = 100 '''''''''''''没见x,y的定义,这里测试随便赋值100


Dim FileName As String
Dim retVal As Boolean
 
'''FileName = Environ("temp") & "\test.bmp"
FileName = "f:\xx\test.bmp" ''''保存到f盘xx目录下,注意修改需要保存到的位置


retVal = capFileSaveDIB(hCapWnd, FileName)
 
sheetindex = "sheets2"'插入到的工作表名称
Row = 2 '第几行
cell = "B" '第几列


With Worksheets(sheetindex).Pictures.Insert(FileName)

  Set cell = Worksheets(sheetindex).Cells(Row, cell)

   If cell.Width > x Then .Left = cell.Left + (cell.Width - x) / 2 Else .Left = cell.Left
   If cell.Height > y Then .Top = cell.Top + (cell.Height - y) / 2 Else .Top = cell.Top
   .Height = y
   .Width = x
End With

'''Kill FileName'''''''''''''注释掉,要不会删除文件

End Sub




img