保存数据

徐海洋

求助：点“保存”，数据存入“明细表”，照片存入文件夹“照片”中，“明细表”证号不能重复，请高师赐教，谢谢

简历保存.7z (71.74 KB, 下载次数: 0)

2024-5-29 14:40 上传

点击文件名下载附件

Qs18

Sub mysave()
Dim rng As Range
    k = Sheet2.Cells(Rows.Count, "a").End(xlUp).Row + 1
With Sheet1
Set rng = Sheet2.Cells.Find(.Range("c5"))
    If rng Is Nothing Then
    Sheet2.Range("a" & k) = k - 2
    Sheet2.Range("b" & k) = .Range("c2")
    Sheet2.Range("c" & k) = .Range("e2")
    Sheet2.Range("d" & k) = .Range("e3")
    Sheet2.Range("e" & k) = "'" & .Range("c4")
    Sheet2.Range("f" & k) = "'" & .Range("c5")
    Sheet2.Range("g" & k) = .Range("f4")
    Sheet2.Range("h" & k) = .Range("g2")
    Sheet2.Range("i" & k) = .Range("c3")
    Sheet2.Range("j" & k) = .Range("g3")
    Sheet2.Range("k" & k) = .Range("f5")
    Sheet2.Range("l" & k) = .Range("h5")
Else
MsgBox "证件号码已经存在"
: End
End If
End With
Call 导出图片
MsgBox "保存完毕！"
End Sub
Sub 导出图片()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
pth = ThisWorkbook.Path & "\照片\"
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Name
Debug.Print shp.Type
If shp.Type = 1 Or shp.Type = 13 Then
n = n + 1
shp.Copy
With ActiveSheet.ChartObjects.Add(O, O, shp.Width, shp.Height).Chart
.Parent.Select
.Paste

.Export pth & [c2] & [c5].Value & ".jpg"
.Parent.Delete
End With
End If
Next
App1ication.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

徐海洋

Qs18 发表于 2024-5-26 17:34
Sub mysave()
Dim rng As Range
    k = Sheet2.Cells(Rows.Count, "a").End(xlUp).Row + 1

谢谢老师，真是论坛藏高师
老师，请再修改一下！！！
1，保存后，清空“登记表”
2，如果修改内容，点“保存”，同“身份证号”，覆盖保存

Qs18

Sub mysave()
Dim rng As Range
    k = Sheet2.Cells(Rows.Count, "a").End(xlUp).Row + 1
With Sheet1
If .Range("c5") = "" Then
MsgBox "请把信息补充完整！"
End
End If
Set rng = Sheet2.Cells.Find(.Range("c5"))
    If rng Is Nothing Then
    Sheet2.Range("a" & k) = k - 2
    Sheet2.Range("b" & k) = .Range("c2")
    Sheet2.Range("c" & k) = .Range("e2")
    Sheet2.Range("d" & k) = .Range("e3")
    Sheet2.Range("e" & k) = "'" & .Range("c4")
    Sheet2.Range("f" & k) = "'" & .Range("c5")
    Sheet2.Range("g" & k) = .Range("f4")
    Sheet2.Range("h" & k) = .Range("g2")
    Sheet2.Range("i" & k) = .Range("c3")
    Sheet2.Range("j" & k) = .Range("g3")
    Sheet2.Range("k" & k) = .Range("f5")
    Sheet2.Range("l" & k) = .Range("h5")
Else
MsgBox "证件号码已经存在"
: End
End If

End With
    Call 导出图片
    Call 清空
MsgBox "保存完毕！"
End Sub
Sub 修改()
Dim rng As Range
Dim k
With Sheet1
If .Range("c5") = "" Then
MsgBox "请把信息补充完整！"
End
End If
Set rng = Sheet2.Cells.Find(.Range("c5"))
If rng Is Nothing Then
    MsgBox "查无此人无需修改，请点击保存"
    End
End If
    k = rng.Row
    Sheet2.Range("b" & k) = .Range("c2")
    Sheet2.Range("c" & k) = .Range("e2")
    Sheet2.Range("d" & k) = .Range("e3")
    Sheet2.Range("e" & k) = "'" & .Range("c4")
    Sheet2.Range("f" & k) = "'" & .Range("c5")
    Sheet2.Range("g" & k) = .Range("f4")
    Sheet2.Range("h" & k) = .Range("g2")
    Sheet2.Range("i" & k) = .Range("c3")
    Sheet2.Range("j" & k) = .Range("g3")
    Sheet2.Range("k" & k) = .Range("f5")
    Sheet2.Range("l" & k) = .Range("h5")

End With
    Call 导出图片
    Call 清空
MsgBox "修改成功！"
End Sub

Sub 清空()
    With Sheet1
    .Range("c2") = ""
    .Range("e2") = ""
    .Range("e3") = ""
    .Range("c4") = ""
    .Range("c5") = ""
    .Range("f4") = ""
    .Range("g2") = ""
    .Range("c3") = ""
    .Range("g3") = ""
    .Range("f5") = ""
    .Range("h5") = ""
    End With
End Sub
Sub 导出图片()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
pth = ThisWorkbook.Path & "\照片\"
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Name
Debug.Print shp.Type
If shp.Type = 1 Or shp.Type = 13 Then
n = n + 1
shp.Copy
With ActiveSheet.ChartObjects.Add(O, O, shp.Width, shp.Height).Chart
.Parent.Select
.Paste

.Export pth & [c2] & [c5].Value & ".jpg"
.Parent.Delete
End With
End If
Next
App1ication.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

徐海洋

Qs18 发表于 2024-5-26 21:07
Sub mysave()
Dim rng As Range
    k = Sheet2.Cells(Rows.Count, "a").End(xlUp).Row + 1

谢谢老师，照片怎么没清空呢？

Qs18

徐海洋 发表于 2024-5-27 09:17
谢谢老师，照片怎么没清空呢？

加一段代码就可以了

徐海洋

Qs18 发表于 2024-5-27 10:22
加一段代码就可以了

老师这段代码复杂哟，费了老师不少心血，海洋在此表示真诚的感谢

LIUZHU

不熟练，参考别人的代码练习了下

LIUZHU

JSA代码，供参考

1. function 简历保存(){
   
2.         let sh=Range("a1").Worksheet;
   
3.         let bt=Sheets.Item("明细表").Range("b2:l2").Value2[0];
   
4.         let res=bt.reduce((res,x,i)=>{
   
5.                 let rng=Cells.Find(x);
   
6.                 if (rng!=null) res[i+1]=rng.Offset(0,1).Value2;
   
7.                 return res;
   
8.         },["=ROW()-ROW($A$2)"]);
   
9.         with(Sheets.Item("明细表")){
   
10.                 if (Cells.Find(res[5])==null){
    
11.                         let r1=Range("a"+ Rows.Count).End(xlUp).Row + 1;
    
12.                         Range(`a${r1}`).Resize(1,res.length).Value2=res;
    
13.                         for (let shp of ActiveSheet.Shapes){
    
14.                                 if (shp.Type==1){
    
15.                                         shp.Copy();
    
16.                                         let cht=sh.ChartObjects().Add(0, 0, shp.Width, shp.Height).Chart;
    
17.                                         cht.Paste();
    
18.                                         cht.Export(`${ThisWorkbook.Path}\\照片\\${res[1]}${res[5]}.jpg`);
    
19.                                         cht.Parent.Delete();
    
20.                                 }
    
21.                         }
    
22.                         alert("保存完毕。")
    
23.                 }else{
    
24.                         alert("姓名已存在，不能保存。");
    
25.                 }
    
26.         }
    
27. }

复制代码

LIUZHU

附件，WPS打开测试