91首页美女视频,脱光衣服美女视频,韩国美女人体视频

列出所有工作薄的 VBA

由 Mr Colo寫的 VBA 需要在VBA內(nèi)選取 Microfost Visual Basic Applications Extensbility

請在 Tools - 宏 - 安全性 - 選取信任存取 Visual Basic 項目

‘ Module
‘ List All VBA module
Dim x As Long
Dim aList()

Sub GetVbProj()
    Dim oVBC As VBIDE.VBComponent
    Dim Wb As Workbook
    x = 2
    For Each Wb In Workbooks
        For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents
            If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then
                Call GetCodeRoutines(Wb.Name, oVBC.Name)
            End If
        Next
    Next
    With Sheets.Add
        .[A1].Resize(, 3).Value = Array("Workbook", "Module", "Procedure")
        .[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
        Application.Transpose(aList)
        .Columns("A:C").Columns.AutoFit
    End With
End Sub

Private Sub GetCodeRoutines(wbk As String, VBComp As String)
    Dim VBCodeMod As CodeModule
    Dim StartLine As Long

    On Error Resume Next
    Set VBCodeMod = Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule
    With VBCodeMod
        StartLine = .CountOfDeclarationLines + 1
        Do Until StartLine >= .CountOfLines
            ReDim Preserve aList(1 To 3, 1 To x - 1)
            aList(1, x - 1) = wbk
            aList(2, x - 1) = VBComp
            aList(3, x - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
            x = x + 1
            StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
                                            vbext_pk_Proc), vbext_pk_Proc)
            If Err Then Exit Sub
        Loop
    End With
    Set VBCodeMod = Nothing
End Sub

不可以選擇或編輯單元格

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Myrange As Range, KeepOut As Range
    Dim ws As Worksheet

    ‘Full sheet
    ‘Set KeepOut = ActiveSheet.Cells
    ‘Several Columns
    ‘Set KeepOut = ActiveSheet.Range("B:D")
    ‘Test Range
    Set KeepOut = ActiveSheet.Range("A2:C5")

    Set Myrange = Intersect(Target, KeepOut)
    ‘Leave if the intersecttion ws untouched
    If Myrange Is Nothing Then Exit Sub

    ‘Stop select firing a second time
    Application.EnableEvents = False
    If KeepOut.Rows.Count = 65536 And KeepOut.Columns.Count = 256 Then
        ‘Entire sheet is the KeepOut range. Eek!
        ‘Bounce user to a dummy sheet
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets("KickMeTo")
        On Error GoTo 0
        If ws Is Nothing Then
            Set ws = ThisWorkbook.Sheets.Add
            ws.Name = "KickMeTo"
        End If
        MsgBox "Houston we have a problem" & vbNewLine & _
               "You cannot select any cell in " & vbNewLine & "‘" & KeepOut.Parent.Name & "‘" & vbNewLine & _
               "So you have been directed to a different sheet"
        ws.Activate
    ElseIf KeepOut.Rows.Count = 65536 Then
        ‘If all rows are contained in the "KeepOut" range then:
        ‘Now we need to find a cell that is in a column to the right or left of this range
        If KeepOut.Cells(1).Column > 1 Then
            ‘If there is a valid column to the left of the range then select the cell in this column
            Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column - 1).Select
        Else
            ‘Else select the cell in first column to the right of the range
            Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column + 1).Select
        End If
          MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
          "You have been directed to the first free column in the protected range", vbCritical
    ElseIf KeepOut.Rows.Count + KeepOut.Cells(1).Row - 1 = 65536 Then
        ‘Select first cell in Column A before "KeepOut" Range
        Cells(KeepOut.Cells(1).Row - 1, 1).Select
          MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
          "You have been directed to the first free cell in Column A above the protected range", vbCritical
    Else
        ‘Select first cell in Column A beyond "KeepOut" Range
    MsgBox "You cannot select " & KeepOut.Address(False, False) & vbNewLine & _
          "You have been directed to the first free cell in Column A below the protected range", vbCritical
        Cells(KeepOut.Rows.Count + KeepOut.Cells(1).Row, 1).Select
    End If
    Application.EnableEvents = True
End Sub

MicroSoft 沒有文件顯示編碼的大小限制
64K 太大，很難跟進

以下編碼檢示 Module 的大小

Sub get_Mod_Size()
Dim myProject As Object
Dim ComName As String
Dim tempPath As String
Dim fs As Object, a As Object
Dim result As String

‘ **************************************************************************************
‘ Use this to determine the size of a module
‘ Set ModName (component name) and tempPath (where to store the temp fule), then run
‘ **************************************************************************************

‘ Set these to run
ComName = "Module1"
tempPath = "c:\Test.bas"

‘ ***** No action needed after this point *****

‘ Export the component (module, form, etc) - this is only temporary
Set myProject = Application.VBE.ActiveVBProject.VBComponents
myProject(ComName).Export (tempPath)

‘ Get the size of the file created
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.getfile(tempPath)
result = ComName & " uses " & (a.Size / 1000) & " KB."

‘ Return the file size
MsgBox result, vbExclamation

‘ Delete the exported file
fs.Deletefile tempPath

End Sub

測試 WorkSheet 是否存在

Sub IsSheetExist()
Dim wSheet As Worksheet
On Error Resume Next
    Set wSheet = Sheets("Sheet6")
        If wSheet Is Nothing Then
            MsgBox "Worksheet does not exist"
            Set wSheet = Nothing
            On Error GoTo 0
        Else
            MsgBox "Sheet does exist"
            Set wSheet = Nothing
            On Error GoTo 0
        End If
End Sub

讓工作表始終置頂

----------------- Module

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Sub MakeNormal(hwnd As Long)
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub
Public Sub MakeTopMost(hwnd As Long)
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Sub test()
Call MakeTopMost(Application.hwnd)
Call MakeNormal(Application.hwnd)
End Sub

有效性下拉框的高度顯示更多更直觀

Option Explicit

Dim oDpd As Object
Dim sFml1
Dim prvTarget As Range

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Const dFixedPos As Double = "0.8"
    Const dFixWidth As Double = "16"    ‘Change here to change WIDTH of the DropDown
    Dim vld As Validation
    Dim lDpdLine As Long

    If Not prvTarget Is Nothing Then
        If Not oDpd Is Nothing Then
            If oDpd.Value = 0 Then
                prvTarget.Value = vbNullString
            Else
                prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
            End If
            Set prvTarget = Nothing
        End If
    End If

    On Error Resume Next
    oDpd.Delete
    sFml1 = vbNullString
    Set oDpd = Nothing
    On Error GoTo 0

    If Target.Count > 1 Then
        Set oDpd = Nothing
        Exit Sub
    End If

    Set vld = Target.Validation
    On Error GoTo Terminate
    sFml1 = vld.Formula1
    On Error GoTo 0

Set prvTarget = Target

lDpdLine = Range(Mid(sFml1, 2)).Rows.Count

    With Target
        Set oDpd = ActiveSheet.DropDowns.Add( _
                                             .Left - dFixedPos, _
                                             .Top - dFixedPos, _
                                             .Width + dFixWidth + dFixedPos * 2, _
                                             .Height + dFixedPos * 2)
    End With
    With oDpd
        .ListFillRange = sFml1
        .DropDownLines = lDpdLine
        .Display3DShading = True
    End With
Terminate:
End Sub

點擊瀏覽該文件

請問如何不改變activecell之下將某一儲存格顯示於左上角?

ActiveWindow.SmallScroll Up:=65536 ActiveWindow.SmallScroll ToLeft:=256 用上面的方法先回到 A1 再用下面的方法到定點 ActiveWindow.SmallScroll Down:=儲存格列號 - 1 ActiveWindow.SmallScroll ToRight:=儲存格欄號 - 1

ActiveCell.Select ActiveWindow.ScrollRow = ActiveCell.Row ActiveWindow.ScrollColumn = ActiveCell.Column

Application.Goto ActiveCell, True

Save Sheet as WorkBook

Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
‘ End With
On Error Resume Next ‘<< a folder exists
MkDir MyFilePath ‘<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
‘save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub

+++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub BreakExternalLinks()

Dim WS As Worksheet
Dim Rng1 As Range
Dim Cell As Range

    For Each WS In ActiveWorkbook.Worksheets
        With WS
            On Error Resume Next
            Set Rng1 = Cells.SpecialCells(xlCellTypeFormulas, 23)

            ‘  23 - All formulae
            ‘  16 - All formulae with errors
            ‘  2 - All formulae with text
            ‘  4 - All formulae with logic
            ‘  6 - All formulae with text or logic

            On Error GoTo 0
            If Not Rng1 Is Nothing Then
                For Each Cell In Rng1
                    If Left(Cell.Formula, 2) = "=‘" Then
                        Cell.Value = Cell.Value
                    End If
                Next
            End If
            Set Rng1 = Nothing
        End With
    Next

End Sub

使用期限設(shè)定

‘ chijanzen
(原始) 2003/10/1
‘ 今天介紹如何讓Excel檔案有使用期限,範(fàn)例中使用Windows Script"在註冊表上的讀.寫.刪除的用法
‘ 本範(fàn)例使用期限設(shè)定 0 天,所以檔案只能開啟一次就自動銷毀
‘ Script 能使用的根鍵值有五個根鍵名稱
HKEY_CURRENT_USER    ‘縮寫 HKCU
HKEY_LOCAL_MACHINE   ‘縮寫 HKLM
HKEY_CLASSES_ROOT    ‘縮寫 HKCR
HKEY_USERS                  ‘縮寫 HKEY_USERS
HKEY_CURRENT_CONFIG  ‘縮寫 HKEY_CURRENT_CONFIG

Sub CheckFileDate()
    Dim Counter As Long, LastOpen As String, Msg As String
    If RegRead = "" Then
        Term = 0   ‘範(fàn)例用 0 天
        TermDate = DateSerial(Year(Now), Month(Now), Day(Now)) + Term
        MsgBox "本檔案只能使用到" & TermDate & "日" & Chr(13) & "超過期限將自動銷毀"
        RegWrite (Term)
    Else
        If CDate(RegRead) <= Now Then
            RegDelete
            KillMe
        End If
    End If
End Sub
Sub KillMe()
    Application.DisplayAlerts = False
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ThisWorkbook.Close False
End Sub

Sub RegWrite(Term)
‘RegWrite:建立新鍵、將另一個值名稱加入現(xiàn)有鍵 (並將值指派給它)，或變更現(xiàn)有值名稱的值。
    Dim WshShell, bKey
    fname = ThisWorkbook.Name
    TermDate = DateSerial(Year(Now), Month(Now), Day(Now)) + Term
    Regkey = "HKCU\chijanzen\Budget\Date\" & fname
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite Regkey, TermDate, "REG_SZ"
End Sub

Function RegRead()
‘RegRead: 從註冊傳回鍵的值或值名稱
    On Error Resume Next
    Dim WshShell, bKey
    fname = ThisWorkbook.Name
    Regkey = "HKCU\chijanzen\Budget\Date\" & fname
    Set WshShell = CreateObject("WScript.Shell")
    RegRead = WshShell.RegRead(Regkey)
End Function

Sub RegDelete()
‘RegDelete :從註冊刪除某鍵或它的一個值(請小心使用)
    Dim WshShell, bKey
    Regkey = "HKCU\chijanzen\Budget\Date\"
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegDelete Regkey    ‘刪除檔名
End Sub

防止 Excel 關(guān)閉

原碼出自 Tek-Tips Forum

‘ Module

Option Explicit

‘Set Types
Public Type LUID
LowPart As Long
HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(1) As LUID_AND_ATTRIBUTES
End Type

‘ Declare API functions.
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, _
   ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
   (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, _
   ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength _
   As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

‘ Set Set ShutDown Privilege Constants
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2

Public Sub SetShutDownPrivilege()
Dim Phndl As Long, Thndl As Long
Dim MyLUID As LUID
Dim MyPriv As TOKEN_PRIVILEGES, MyNewPriv As TOKEN_PRIVILEGES

Phndl = GetCurrentProcess()
OpenProcessToken Phndl, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, Thndl
LookupPrivilegeValue "", "SeShutdownPrivilege", MyLUID
MyPriv.PrivilegeCount = 1
MyPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
MyPriv.Privileges(0).pLuid = MyLUID
‘ Now to set shutdown privilege for my app
AdjustTokenPrivileges Thndl, False, MyPriv, 4 + (12 * MyPriv.PrivilegeCount), MyNewPriv, 4 + (12 * MyNewPriv.PrivilegeCount)

End Sub

‘ ThisWorkbook

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim Msg, Style, Title, Response
Dim MyFlag As Long, Ret As String
‘Set ShutDown Constants
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4

‘ Define message.
Msg = "Do you want to continue ?" _
    & vbCr & vbCr & "You are about to exit the excel program." _
    & vbCr & vbCr & "You will need to Reboot Computer" _
    & vbCr & "to restore the program!"
Style = vbYesNoCancel + vbCritical + vbDefaultButton3    ‘ Define buttons.
Title = "Exiting Program"    ‘ Define title.
‘ Display message.
Response = MsgBox(Msg, Style, Title)
‘Test the variable Response
Select Case Response
  Case vbYes
    ‘Save the file, Force Windows Closed
    Me.Save
‘   Call Exit_Windows
    Ret = InputBox("Enter Password", "Password Required")
        If Ret = "testing" Then    ‘ 更改你的密碼
        Ret = InputBox("Exit Excel or Logoff User" _
        & vbCr & " Enter: E or L", "What Action")
        Else
        MsgBox "Invalid Password", vbCritical, "Wrong Password"
        Cancel = False
        Exit Sub
        End If
    If Ret = "E" Or Ret = "e" Then
        Application.Quit
    Else
        If Ret = "L" Or Ret = "l" Then
            SetShutDownPrivilege ‘Set the shutdown privilege - else reboot will fail
            ‘ Always execute a force shutdown if a shutdown is required
            MyFlag = EWX_LOGOFF  ‘LogOff
            ‘ Grab the shutdown privilege - else reboot will fail
            SetShutDownPrivilege
            ‘Do the required action
            Call ExitWindowsEx(MyFlag, 0)
        End If
    End If
  Case vbNo
    Worksheets(1).Activate
    Cancel = True
  Case vbCancel
    Cancel = True
  Case Else
  ‘Do Nothing
End Select

End Sub

Private Sub Workbook_Open()
On Error Resume Next
    ‘Activate the 1st worksheet using the workbooks worksheet index
    Worksheets(1).Activate
    ‘Or If you want to use the actual worksheet name
    ‘Worksheets("Sheet1").Activate
End Sub

指定電腦上運行

‘用 F8 逐句執(zhí)行籃色編碼，取值后更改紅色部份

‘ ThisWorkBook

Private Declare Function w32_GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Public LoginTime

Private Sub Workbook_Open()
    Dim TempUName     ‘ User Name
    Dim TempPCName   ‘ PC Name
    TempPCName = GetComputerName
    TempUName = UserName
    If TempPCName <> "PCName01" And TempPCName <> "PCName02" And TempUName <> "BeeBee" _
        And TempPCName <> "EMILY" Then
            MsgBox "Sorry, This File is for BeeBee ONLY."
            Application.Quit
    End If
    End Sub

Function GetComputerName()
    Dim sComputerName As String
    Dim lComputerNameLen As Long
    Dim lResult As Long
    lComputerNameLen = 256
    sComputerName = Space(lComputerNameLen)
    lResult = w32_GetComputerName(sComputerName, lComputerNameLen)
    If lResult <> 0 Then
        GetComputerName = Left(sComputerName, lComputerNameLen)
    Else
        GetComputerName = "Unknown"
    End If
End Function

Function UserName() As String
       Dim Buffer As String * 100
       Dim BuffLen As Long
       BuffLen = 100
       GetUserName Buffer, BuffLen
       UserName = Left(Buffer, BuffLen - 1)
End Function

可以監(jiān)控刪除行及列嗎

‘ Module

   Option Explicit

‘// Worksheet RowColumn Deleted Event
‘// This is NOT a real event but just hack the command button.
‘// You can know when the rows or the columns was deleted by user‘s opelation.

Sub EventHack()       ‘ 執(zhí)行監(jiān)控程序
    AssignMacro "JudgeRng"
End Sub
Sub EventReset()      ‘ 取消監(jiān)控程序
    AssignMacro ""
End Sub

Private Sub AssignMacro(ByVal strProc As String)
    Dim lngId As Long
    Dim CtrlCbc As CommandBarControl
    Dim CtrlCbcRet As CommandBarControls
    Dim arrIdNum As Variant

    ‘// 293=Delete menu of the right click on row
    ‘// 294=Delete menu of the right click on column
    ‘// 293=Delete menu of the Edit of main menu
    arrIdNum = Array(293, 294, 478)

    For lngId = LBound(arrIdNum) To UBound(arrIdNum)
        Set CtrlCbcRet = CommandBars.FindControls(ID:=arrIdNum(lngId))
        For Each CtrlCbc In CtrlCbcRet
            CtrlCbc.OnAction = strProc
        Next
        Set CtrlCbcRet = Nothing
    Next
End Sub

Private Sub JudgeRng()
    If Not TypeOf Selection Is Range Then Exit Sub
    With Selection
        If .Address = .EntireRow.Address Then
            Call DelExecute("Row:" & .Row, xlUp)
        ElseIf .Address = .EntireColumn.Address Then
            Call DelExecute("Column:" & .Column, xlToLeft)
        Else
            Application.Dialogs(xlDialogEditDelete).Show
        End If
    End With
End Sub

Private Sub DelExecute(ByVal str, ByVal lngDerec As Long)
    MsgBox "deleted:" & str
    Selection.Delete lngDerec
End Sub

測試 WorkBook 是否已開啟

Sub IsWorkBookOpen() Dim wBook As Workbook On Error Resume Next Set wBook = Workbooks("Book180.xls") If wBook Is Nothing Then MsgBox "Workbook is not open" Set wBook = Nothing On Error GoTo 0 Else MsgBox "Yes it is open" Set wBook = Nothing On Error GoTo 0 End If End Sub

請問如何不改變activecell之下將某一儲存格顯示于左上角
ActiveCell.Select ActiveWindow.ScrollRow = ActiveCell.Row ActiveWindow.ScrollColumn = ActiveCell.Column
或
Application.Goto ActiveCell, True

如何在 VBA 內(nèi)執(zhí)行 Add-in 函數(shù)
AddIns("VBA 分析工具箱").Installed = True Range("B1") = Application.Evaluate("=Weeknum(now()-7, 2)") AddIns("VBA 分析工具箱").Installed = True Workdays = Application.Evaluate("=NetWorkdays(DATE(2004,1,1) ,DATE(2004,12,31))")
或
Application.Run("ATPVBAEN.xla!Weeknum", Now(), 2)

如何禁止更改工作表名稱
簡單例子
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveSheet.Name <> "Sheet1" Then ActiveSheet.Name = "Sheet1" End If End Sub
詳細例子請參考【禁止更改工作表名稱 Chijanzen】

檢測EXCEL建立時間
Sub CreateDate() On Error Resume Next rw = 1 Worksheets(1).Activate For Each p In ActiveWorkbook.BuiltinDocumentProperties Cells(rw, 1).Value = p.Name Cells(rw, 2).Value = ActiveWorkbook.BuiltinDocumentProperties(p.Name) rw = rw + 1 Next MsgBox ActiveWorkbook.BuiltinDocumentProperties("Creation date") End Sub

Rename CodeName
點擊瀏覽該文件

指定電腦上運行 19/F
可以監(jiān)控刪除行及列嗎 20/F
列出所有工作薄的 VBA 21/F
vba 程式碼(代碼)是否限定容量不得超過 64K 限制嗎 23/F

找格式化的顏色 ( Font 及 Interior)

請參考找格式化的顏色 ( Font 及 Interior)

有沒有辦法在EXCEL的工作表里插入一張會動的gif 動畫
請參考 (向大家推薦一個可以在SHEET中使用的gif動畫插件)
請參考 (不用控件也來顯示GIF動畫)
如何一打開工作簿,關(guān)閉所有工作表,剩 sheet1 為活動工作表
請參考
點擊瀏覽該文件 , 用快速鍵 CRTL s 可轉(zhuǎn)換下一頁，現(xiàn)在只有三頁(可以增加)
如何另存文件時不保存文件的宏
請參考 (在背景作業(yè)中另存新檔 chijanzen)
找尋自定范圍名稱左上、左下、右上及右下地址

請參考
點擊瀏覽該文件
請教如何在單元格里獲得頁碼和總頁數(shù)
請參考 (請教如何在單元格里獲得頁碼和總頁數(shù))
加長驗證的長度及寬度
請參考加長驗證的長度及寬度
如何改變列表框下拉的字體格式
Excel 本身自帶的驗證下拉列表是沒有這功能，可用 Combox 方式，請參考附件
點擊瀏覽該文件

請問全屏顯示后，如何不顯示“關(guān)閉全屏顯示”工具欄
Sub hidebar() ‘ chijanzen Application.CommandBars(1).Enabled = False Application.DisplayFullScreen = True Application.CommandBars("Full Screen").Visible = False With ActiveWindow .DisplayHorizontalScrollBar = False .DisplayVerticalScrollBar = False End With End Sub Sub unhidebar() Application.CommandBars(1).Enabled = True Application.DisplayFullScreen = False With ActiveWindow .DisplayHorizontalScrollBar = True .DisplayVerticalScrollBar = True End With End Sub
怎樣隱藏windows下面的任務(wù)欄 請參考【隱藏任務(wù)欄】
可以在不影響活頁薄情況下顯示時間嗎
請參考【在工具列新增1個常駐的電子時鐘 Chijanzen】
請參考 Ivan F Moala
點擊瀏覽該文件
怎樣判斷空工作表？并自動刪除
If IsEmpty(ActiveSheet.UsedRange) And ActiveSheet.Shapes.Count = 0 Then ActiveSheet.Delete

本站僅提供存儲服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請點擊舉報。

国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看