Sub 戶口導(dǎo)入文件工作表選擇()
Dim i As Integer, sp As Shape, n As Integer
MsgBox "按確定按鈕開(kāi)始導(dǎo)入數(shù)據(jù)，請(qǐng)稍候,！ ", 64, "系統(tǒng)提示："
    Application.ScreenUpdating = False
    With thisworkbook.ActiveSheet '在當(dāng)前激活的工作表運(yùn)行宏
    ActiveSheet.Unprotect ("") '工作表解密
        .Cells.Clear
        For i = 1 To UBound(arrf)
            If WorksheetFunction.CountA(wk.Sheets(arrf(i)).Cells) > 0 Then
                wk.Sheets(arrf(i)).UsedRange.Copy .Range("a1").End(3).Offset(0) 'Offset(0)表示復(fù)制到a1單元格
            End If
        Next
    End With
    wk.Close False
    Set wk = Nothing
    Erase arrf
    Range("F3:H3").FormulaR1C1 = "=MID(CELL(""filename"",R[-2]C[-5]),FIND(""]"",CELL(""filename"",R[-2]C[-5]),1)+1,LEN(CELL(""filename"",R[-2]C[-5])))"
    Range("A8:AL8").Select
    Selection.AutoFilter '區(qū)間篩選
    Rows("8:65536").Locked = False '允許用戶編輯區(qū)域
    Range("J9").Select '凍結(jié)窗口
    ActiveWindow.FreezePanes = True
    ActiveWindow.Zoom = 90 '顯示比例
    For Each sp In ActiveSheet.Shapes '刪除細(xì)小圖形代碼
    If sp.Width < 14.25 Or sp.Height < 14.25 Then   '約小于0.5cm,，根據(jù)需要設(shè)定
    sp.Delete
    n = n + 1
    End If
    Next sp
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
        AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True '有條件保護(hù)工作表
    ActiveSheet.EnableSelection = xlUnlockedCells '保護(hù)時(shí)啟用自動(dòng)篩選
    Application.ScreenUpdating = True
    ActiveWindow.DisplayHeadings = True '恢復(fù)行號(hào)列標(biāo)
    MsgBox "導(dǎo)入完畢，請(qǐng)查看,！ ", 64, "系統(tǒng)提示："
End Sub

Sub 學(xué)生信息數(shù)據(jù)導(dǎo)入()
If Cells(2, 12).Value = "學(xué)年初在校學(xué)生花名冊(cè)" Then '當(dāng)Cells(2,13).Value等于...時(shí)運(yùn)行宏
    Dim filetoopen
    filetoopen = Application _
                 .GetOpenFilename("Excel Files (*.xls), *.xls", 1, "EXCEL 戶口數(shù)據(jù)導(dǎo)入：")
    If filetoopen = False Then Exit Sub
    If filetoopen = thisworkbook.FullName Then
        MsgBox "不可以選擇本文件,！ ", 16, "系統(tǒng)提示："
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set wk = Application.Workbooks.Open(filetoopen)
    wk.Windows(1).Visible = False '隱藏當(dāng)前導(dǎo)入數(shù)據(jù)的文件
    thisworkbook.Activate
    Application.ScreenUpdating = False
    學(xué)生信息導(dǎo)入.Show
Else
   MsgBox "進(jìn)入學(xué)生信息錄入表才能導(dǎo)入數(shù)據(jù)！ ", 64, "系統(tǒng)提示："
End If
End Sub
Sub 學(xué)生信息選擇()
Dim i As Integer, sp As Shape, n As Integer
MsgBox "按確定按鈕開(kāi)始導(dǎo)入數(shù)據(jù),，請(qǐng)稍候,！ ", 64, "系統(tǒng)提示："
    Application.ScreenUpdating = False
    With thisworkbook.ActiveSheet '在當(dāng)前激活的工作表運(yùn)行宏
    ActiveSheet.Unprotect ("") '工作表解密
        .Cells.Clear
        For i = 1 To UBound(arrf)
            If WorksheetFunction.CountA(wk.Sheets(arrf(i)).Cells) > 0 Then
                wk.Sheets(arrf(i)).UsedRange.Copy .Range("a1").End(3).Offset(0) 'Offset(0)表示復(fù)制到a1單元格
            End If
        Next
    End With
    wk.Close False
    Set wk = Nothing
    Erase arrf
    Range("K2").FormulaR1C1 = _
        平塘縣""&a!R[9]C[112]&a!R[15]C[112]&a!R[15]C[113]&a!R[15]C[114]"
    Range("C6:V6").Select
    Selection.AutoFilter '區(qū)間篩選
    Rows("6:65536").Locked = False '允許用戶編輯區(qū)域
    Range("H7").Select '凍結(jié)窗口
    ActiveWindow.FreezePanes = True
    ActiveWindow.Zoom = 90 '顯示比例
    For Each sp In ActiveSheet.Shapes '刪除細(xì)小圖形代碼
    If sp.Width < 14.25 Or sp.Height < 14.25 Then   '約小于0.5cm，根據(jù)需要設(shè)定
    sp.Delete
    n = n + 1
    End If
    Next sp
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:= _
        True, AllowFiltering:=True, AllowUsingPivotTables:=True '有條件保護(hù)工作表
    ActiveSheet.EnableSelection = xlUnlockedCells '保護(hù)時(shí)啟用自動(dòng)篩選
    Application.ScreenUpdating = True
    ActiveWindow.DisplayHeadings = True '恢復(fù)行號(hào)列標(biāo)
    MsgBox "導(dǎo)入完畢,，請(qǐng)查看,！ ", 64, "系統(tǒng)提示："
End Sub