专家坐堂-截图自动命名增加Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  截图自动命名增加  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=89735)

--  作者：yifan3429
--  发布时间：2016/8/28 21:53:00
--  截图自动命名增加

If e.Col.name = "检索" Then
baseMainForm.WindowState= Windows.forms.FormWindowState.Minimized
ClipBoard.Clear
Dim proc As new Process
proc.File = ApplicationPath & "/capture.exe"
proc.WaitForClose = True
proc.Start
If ClipBoard.GetImage IsNot Nothing Then
Dim f As String = e.Row("大类") & "\\" & "文件检索图" & "\\"& Format( date.Today,"yyyy-MM-dd") & "/" & e.Row("二类") & e.Row("三类") & ".jpg"
Dim path As String = e.Col.DataCol.DefaultFolder
If path = "" Then
path = ProjectPath & "Attachments/"
End If
basemainform.WindowState = 2
Dim dir As String = FileSys.GetParentPath(path & "/" & f)
If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
ClipBoard.GetImage.save(path & "/" & f)
e.Row(e.Col.name) = f
End If
e.cancel = True
End If

截图只能有一个命名如果需要增加多个截图如何自动增加命名序号

--  作者：Hyphen
--  发布时间：2016/8/29 9:11:00
--
1、日期加上时间作为文件名

2、如果要顺序增加，就要循环目录下所有文件，获取序号最大的文件，+1
或者循环+1判断是否操作同名的文件名，如

Dim path As String = Args(0)
Dim filename As String = Args(1)

Dim n() As String
n = filename.Split(".")

Dim idx As Integer = 1
Dim newname As String = name

Do While 1=1
If FileSys.FileExists(path & newname) Then
newname = n(0) & "(" & idx & ")." & n(1)
idx = idx+1
Else
Exit Do
End If
Loop

return newname

--  作者：大红袍
--  发布时间：2016/8/29 9:24:00
--

一个单元格增加多个图片？

If e.Col.name = "检索" Then
    baseMainForm.WindowState= Windows.forms.FormWindowState.Minimized
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String = e.Row("大类") & "\\" & "文件检索图" & "\\"& Format( date.Today,"yyyyMMddHHmmss") & "/" & e.Row("二类") & e.Row("三类") & ".jpg"
        Dim path As String = e.Col.DataCol.DefaultFolder
        If path = "" Then
            path = ProjectPath & "Attachments/"
        End If
        basemainform.WindowState = 2
        Dim dir As String = FileSys.GetParentPath(path & "/" & f)
        If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
        ClipBoard.GetImage.save(path & "/" & f)
        e.Row(e.Col.name) = f & vbcrlf & e.Row(e.Col.name)
    End If
    e.cancel = True
End If

--  作者：yifan3429
--  发布时间：2016/8/30 7:56:00
--

以下是引用大红袍在2016/8/29 9:24:00的发言：

一个单元格增加多个图片？

If e.Col.name = "检索" Then
    baseMainForm.WindowState= Windows.forms.FormWindowState.Minimized
    ClipBoard.Clear
    Dim proc As new Process
    proc.File = ApplicationPath & "/capture.exe"
    proc.WaitForClose = True
    proc.Start
    If ClipBoard.GetImage IsNot Nothing Then
        Dim f As String = e.Row("大类") & "\\" & "文件检索图" & "\\"& Format( date.Today,"yyyyMMddHHmmss") & "/" & e.Row("二类") & e.Row("三类") & ".jpg"
        Dim path As String = e.Col.DataCol.DefaultFolder
        If path = "" Then
            path = ProjectPath & "Attachments/"
        End If
        basemainform.WindowState = 2
        Dim dir As String = FileSys.GetParentPath(path & "/" & f)
        If FileSys.DirectoryExists(dir) = False Then FileSys.CreateDirectory(dir)
        ClipBoard.GetImage.save(path & "/" & f)
        e.Row(e.Col.name) = f & vbcrlf & e.Row(e.Col.name)
    End If
    e.cancel = True
End If

就是增加序号就行了最好事日期加序号按月重编
山方面的代码测试不能两次截屏的话会覆盖第一个

--  作者：Hyphen
--  发布时间：2016/8/30 9:56:00
--
看2楼