VBA代码收集整理.docVIP

开始-打印机和传真机-右健该打印机图标-打印首选项-灰度打印或黑色打印前面加勾就可以了.Dim A As Range Set A = Sheets(员工信息).Cells.Find(员工编号) If Not A Is Nothing Then MsgBox 已存在该编号记录 Exit Sub End If *********************************** On Error Resume Next Dim x As Integer, Y As Integer Dim Mrng As Range With Sheets(员工信息) Y = .Range(A65536).End(xlUp).Row + 1 For x = 1 To Me.Controls.Count Set Mrng = .Cells.Find(Me.Controls(x).Name) .Cells(Y, Mrng.Column) = Me.Controls(x).Text Next x End With MsgBox 添加成功, 64 Set Mrng = Nothing 清空所有内容 End Sub Private Sub 修改_Click() On Error Resume Next Dim x As Integer, Y As Integer Dim Mrng As Range If 姓名 = Then Exit Sub With Sheets(员工信息) Y = .Cells.Find(员工编号).Row For x = 1 To Me.Controls.Count Set Mrng = .Cells.Find(Me.Controls(x).Name) .Cells(Y, Mrng.Column) = Me.Controls(x).Text Next x End With MsgBox 修改成功, 64 Set Mrng = Nothing End Sub Private Sub 退出_Click() Unload Me End Sub ‘自动找到活动工作簿的路径并生成模板 Function FileOpened(BName) As Boolean On Error Resume Next If Len(Workbooks(BName).Name) 0 Then If Err.Number = 9 Then FileOpened = False Else FileOpened = True End If End If End Function Function FileExist(FName) As Boolean Dim x As String x = Dir(FName) If x Then FileExist = True Else FileExist = False End If End Function Sub 自动生成模板() Dim OpenFName$, FileSource$ OpenFName = 模板.xls FileSource = ActiveWorkbook.Path If FileOpened(OpenFName) Then MsgBox OpenFName is opened! Else If FileExist(FileSource OpenFName) Then Workbooks.Open FileSource OpenFName Else ActiveWorkbook.SaveAs ActiveWorkbook.Path \ 模板.xls End If End If End Sub ‘在当前E4单元格自动生成本月第一天的日期和日期格式“yyyy””-“”mm””-“”dd” Sub 自动生成本月日期() Range(E4).Select Selection.NumberFormatLocal = d [E4] = Now() - Day(Now()) + 1 End Sub Sub 插入多个工作表并命名() On Error GoTo 100 Dim i As Integer For i = 12 To 1 Step -1 Sheets.Add.N