Excel word ppt office使用技巧大全(DOC格式)-第74部分

快捷操作: 按键盘上方向键 ← 或 → 可快速上下翻页 按键盘上的 Enter 键可回到本书目录页 按键盘上方向键 ↑ 可回到本页顶部! 如果本书没有阅读完，想下次继续接着阅读，可使用上方 "收藏到我的浏览器" 功能 和 "加入书签" 功能！




　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　返回用户名　　



Public　Declare　Function　GetUserName　Lib　〃advapi32。dll〃　_　　

Alias　〃GetUserNameA〃　（ByVal　lpBuffer　As　String；　nSize　As　Long）　As　Long　　

　　

Function　ReturnUserName（）　As　String　　

'　returns　the　NT　Domain　User　Name　　

Dim　rString　As　String　*　255；　sLen　As　Long；　tString　As　String　　

　　　　　　tString　=　〃〃　　

　　　　　　On　Error　Resume　Next　　

　　　　　　sLen　=　GetUserName（rString；　255）　　

　　　　　　sLen　=　InStr（1；　rString；　Chr（0））　　

　　　　　　If　sLen　》　0　Then　　

　　　　　　　　　　tString　=　Left（rString；　sLen　　1）　　

　　　　　　Else　　

　　　　　　　　　　tString　=　rString　　

　　　　　　End　If　　

　　　　　　On　Error　GoTo　0　　

　　　　　　ReturnUserName　=　UCase（Trim（tString））　　

End　Function　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　将　UserForm　与　Excel　分开　　



Option　Explicit　　

Private　　Declare　　Function　　SetWindowPos　　Lib　　〃user32〃　　（ByVal　　hwnd　　As　　Long；　　ByVal　　

hWndInsertAfter　As　Long；　ByVal　X　As　Long；　ByVal　Y　As　Long；　ByVal　cx　As　Long；　ByVal　cy　As　　

Long；　ByVal　wFlags　As　Long）　As　Long　　

Private　Declare　Function　FindWindow　Lib　〃user32〃　Alias　〃FindWindowA〃　（ByVal　lpClassName　　

As　String；　ByVal　lpWindowName　As　String）　As　Long　　

Private　Declare　Function　ClipCursor　Lib　〃user32〃　（lpRect　As　Any）　As　Long　　

Private　Declare　Function　SetForegroundWindow　Lib　〃user32〃　（ByVal　hwnd　As　Long）　As　Long　　

Const　ID　=　〃123〃　　

　　

Private　Sub　mandButton1_Click（）　　

If　TextBox1　=　ID　Then　　

　　　　　　Unload　UserForm1　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　433　　


…………………………………………………………Page　434……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　Exit　Sub　　

Else　　

　　　　　　UserForm1。Height　=　UserForm1。Height　30　　

　　　　　　UserForm1。Width　=　UserForm1。Width　30　　

　　　　　　TextBox1　=　〃〃　　

　　　　　　TextBox1。SetFocus　　

End　If　　

If　UserForm1。Height　《　80　Then　　

　　MsgBox　〃不知道密碼就不要再撐了！按〃〃X〃〃離開吧！〃　　

End　If　　

End　Sub　　

　　

Private　Sub　mandButton2_Click（）　　

　　　　　　TextBox1　=　〃〃　　

　　　　　　TextBox1。SetFocus　　

End　Sub　　

　　

Private　Sub　UserForm_Initialize（）　　

Application。EnableCancelKey　=　xlDisabled　　

SetWindowPos　hWndForm；　…1；　0&；　0&；　0&；　0&；　3　　　　　　'讓視窗保持最上層　　

Call　SetForegroundWindow（hWndForm）　　　　'讓視窗取得焦點　　

　　

End　Sub　　

Function　hWndForm（）　As　Long　　

　　　　　　　　hWndForm　=　FindWindow（〃ThunderDFrame〃；　UserForm1。Caption）　'UserForm　　

End　Function　　

　　

　　

Private　Sub　UserForm_QueryClose（Cancel　As　Integer；　CloseMode　As　Integer）　　

If　Not　TextBox1　=　ID　Then　　

ThisWorkbook。Saved　=　True　　

ThisWorkbook。Close　　

End　If　　

SetWindowPos　hWndForm；　…2；　0&；　0&；　0&；　0&；　3　　

Application。EnableCancelKey　=　xlInterrupt　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　如何用　API　获得当前登录用户　　



Option　Explicit　　

Private　Declare　Function　GetUserName　Lib　〃advapi32。dll〃　Alias　〃GetUserNameA〃　_　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　（ByVal　lpBuffer　As　String；　_　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　nSize　As　Long）　As　Long　　

　　

Sub　Get_User_Name（）　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　434　　


…………………………………………………………Page　435……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　

　　　　　　Dim　lpBuff　As　String　*　25　　

　　　　　　Dim　ret　As　Long；　UserName　As　String　　

　　　　　　ret　=　GetUserName（lpBuff；　25）　　

　　　　　　UserName　=　Left（lpBuff；　InStr（lpBuff；　Chr（0））　　1）　　

　　　　　　MsgBox　UserName　　

　　　　　　End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　怎样才能实现在输入重复的数据时自动跳到重复处提示呢　　



方法　1：在数据/有效性/　自定义中输入此公式：　　　=COUNTIF（A：A；A1）=1　当输入相同号码时；会拒　

绝输入。　　

方法　2　：Private　Sub　Worksheet_Change（ByVal　Target　As　Range）　　

　　　　On　Error　Resume　Next　　

　　　　If　Target。Column　=　　1　Then　　

　　　　　　　　If　Target。value　　〃〃　Then　　

　　　　　　　　　　　　Set　c　=　Sheet1。Range（〃A1：A〃　&　Target。Offset（…1；　0）。Row）。Find（Target。value；　LookIn：=xlval　

ue；　Lookat：=xlWhole）　　

　　　　　　　　　　　　If　Not　c　Is　Nothing　Then　　

　　　　　　　　　　　　　　　　MsgBox　〃该号码已有了〃　　

　　　　　　　　　　　　　　　　c。Select　　

　　　　　　　　　　　　　　　　Target。value　=　〃〃　　

　　　　　　　　　　　　End　If　　

　　　　　　　　End　If　　

　　　　End　If　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　用公式表示当前单元格所在行的第一列的值　　



解答：cells（所在行行号，1）。value　或者用公式=INDIRECT（〃a〃&ROW（））　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　怎样将列号，转变为对应的字母　　



如：列号　9，对应的字母应该是〃I〃；列号　27　，对应的字母应该是〃AA〃。　　

解答：Function　ColumnLetter（ColumnNumber　As　Integer）　As　String　　

　　　　If　ColumnNumber　《　　1　Or　ColumnNumber　》　256　Then　　

　　　　　　　　MsgBox　〃Invalid　Column　Number〃　　

　　　　　　　　Exit　Function　　

　　　　ElseIf　ColumnNumber　》　26　Then　　

　　　　　　　　ColumnLetter　=　Chr（Int（（ColumnNumber　　1）　/　26）　＋　64）　&　_　　

　　　　　　　　　　　　Chr（（（ColumnNumber　　1）　Mod　26）　＋　65）　　

　　　　Else　　

　　　　　　　　　　　　ColumnLetter　=　Chr（ColumnNumber　＋　64）　　

　　　　End　If　　

End　Function　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　435　　


…………………………………………………………Page　436……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　EXCEL　能否按照单元格内文字的颜色排序　　



EXCEL　能否按照单元格内文字的颜色排序，或把相同颜色的行集中到一起显示。　　

　　　　解答：方法一，1。以VBA　判斷　colorindex，加輔助欄實現；2。不以程式輔助要實現………》　

不可能。　　

　　　　方法二，不用　VBA　也可以的；可用　get。cell（24）　　EXCEL　宏函数定义名称；辅助列还是需　

要的。　　



　　　　　　　　　　　　　　　　　　　怎么能让一个加载宏监控所有打开的　excel　文件　　



我们可以在　thisworkbook_open　或　sheet1_activate　中加入自己的代码从而监视本文件中的各　

个事件，执行指定的代码。但如果你编写的是一个加载宏，你所要监视的文件就不单单是当　

前的文件了，而是所有打开的文件。但加载宏在后台运行时，用户可能会新打开或关闭文件　

等执行各种操作，从而可能会出现错误。　　

为了实现加载宏在后台对所有操作进行监控，我把　Excel　帮助翻个底朝天，终于实现了这种效　

果。这几天看到有些朋友也存在这中问题，将自己的一点心得拿出来与大家分享。　　

要实现这种效果，首先要定义一个　Application　类　　

在　VBA　项目中添加一个类模块　AppEventCls　，进行声明：　　

Public　WithEvents　App　As　Application　　

这时在代码编辑窗口上面的对象下拉框中就多出了一个新的对象“App”　，选中“App”　，右边的事　

件下拉框中可以看到对应的事件“NewWorkbook”　，“SheetActivate”等，哈！这就是我们所要的！　

选中“NewWorkbook”　，在代码编辑窗口中出现：　　

Private　Sub　App_NewWorkbook（ByVal　Wb　As　Workbook）　　

End　Sub　　

添加代码：　　

MsgBox　〃Hey！　You　opened　a　new　workbook！〃　　

现在可以执行了吗？噢，还要等一下，我们必须先定义一个属于这个类的对象。　　

在项目中添加一个新的模块　　

添加对象的定义　　

Dim　MyApp　As　New　AppEventCls　　

在自动运行过程中指定对象　　

Public　Sub　Auto_Open（）　　

　　　　　　Set　MyApp。App　=　Application　　

End　Sub　　

将文件存为加载宏，如“ControlApp。xla”　，然后就可以欣赏自己的成果了！　　

关闭此文件，然后加载刚保存的加载宏。打开一个文件试试。　　

在类模块中的其他事件中加入代码试试，可以看到这个加载宏响应所有文件的事件！　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　把公式排整齐　　



公式太长，尤其当使用了许多函数，括号一层迭一层时，公式便会变得难以理解。你可以在适　

当位置按＜Alt　＞＋　＜Enter　＞来插入分列符号，甚至加进空格，把公式排得整整齐齐。　　



　　　　　　　　　　　　　　　　　　　　　　　　　寻找特定档案并以对应的软件开启　　



可否在　　excel　　中输入一个　　档名，excel　　会到预定　　path　　下的　　folder　　找出该案并开启呢？　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　436　　


…………………………………………………………Page　437……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



解答　1：如果知道具体位置，可这样：　　

Sub　Find_WorkBook（）　　

Dim　wb　As　Workbook　　

Dim　String1；　String2；　Message；　Title；　Default　As　String　　

Default　=　〃WindRider〃　　

Title　=　〃Find　WorkBook〃　　

String1　=　InputBox（Message；　Title；　Default）　　

　　　　　　String2　=　Application。ActiveWorkbook。Path　　

　　　　　　Set　wb　=　Workbooks。Open（String2　&　〃”　&　String1　&　〃。xls〃；　False；　False）　　

End　Sub　　

解答　2：如果只知道文档会在某个　　path　　下，但实际位置要　　search，可这样：　　

Sub　Find_WorkBook（）　　

On　Error　Resume　Next　　

Dim　wb　As　Workbook　　

Dim　String1；　String2；　Message；　Title；　Default　As　String　　

Default　=　〃OnKey〃　　

Title　=　〃Find　WorkBook〃　　

String1　=　InputBox（Message；　Title；　Default）　　

　　

　　　　　　If　String1　=　〃〃　Then　　

　　　　　　　　　　Exit　Sub　　

　　　　　　End　If　　

　　　　　　With　Application。FileSearch　　

　　　　　　　　　　。NewSearch　　

　　　　　　　　　　。LookIn　=　〃E：Autos〃　　

　　　　　　　　　　。MatchTextExactly　=　True　　

　　　　　　　　　　。FileType　=　msoFileTypeExcelWorkbooks　　

　　　　　　　　　　。SearchSubFolders　=　True　　

　　　　　　　　　　。Filename　=　Trim（String1）　&　〃。xls〃　　

　　　　　　　　　　If　。Execute（）　》　0　Then　　

　　　　　　　　　　　　　　　　String2　=　。FoundFiles（1）　　

　　　　　　　　　　　　　　　　Set　wb　=　Workbooks。Open（String2；　False；　False）　　

　　　　　　　　　　Else　　

　　　　　　　　　　　　　　　　MsgBox　（〃File　No　Found！〃）　　

　　　　　　　　　　　　　　　　Exit　Sub　　

　　　　　　　　　　End　If　　

　　　　　　End　With　　

　　　　　　End　Sub　　

（'Default　=　〃OnKey〃　　是设定输入对话方块的预设值。'FoundFiles（1）可能发现很多个相同名称　

的文件，但我要打开的是第一个发现的文件。'改成　　FileType　=　msoFileTypeAllFiles。）　　

又问：如何根据找到的档案以相关的程式开启呢？　　

答：ActiveWorkbook。FollowHyperlink　。FoundFiles（1）　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　437　　


…………………………………………………………Page　438……………………………………………………………

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　如何将文件中的某一类控件全部删除　　



我的文件中有各种各样的控件，我希望将所有工作表中某一类控件（如　mandbutton，包　

括隐藏的控件）全部删除，程序怎么编？　　

解答：Sub　Dtlshtbtn（）　　

For　Each　sht　In　ActiveWorkbook。Sheets　　

　　　　　　For　Each　BtnObj　In　sht。OLEObjects　　

　　　　　　　　　　If　Left（BtnObj。Name；　13）　=　〃mandButton〃　Then　　

　　　　　　　　　　　　　　　　BtnObj。Delete　　

　　　　　　　　　　End　If　　

　　　　　　Next　BtnObj　　

Next　sht　　

End　Sub　　

又问：我的控件的　name　已改过（初期设计时未注意规范），不能保证前几位是相同的，有什　

么办法判断？　　

解答：改一下即可　　

Sub　Dtlshtbtn（）　　

　　　　　　For　Each　sht　In　ActiveWorkbook。Sheets　　

　　　　　　　　　　For　Each　btnobj　In　sht。OLEObjects　　

　　　　　　　　　　　　　　　　If　Left（btnobj。ProgId；　19）　=　〃Forms。mandButton〃　Then　　

　　　　　　　　　　　　　　　　　　　　　　btnobj。Delete　　

　　　　　　　　　　　　　　　　End　If　　

　　　　　　　　　　Next　btnobj　　

　　　　　　Next　sht　　

End　Sub　　



　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　如何列出工具栏快显菜单和单元格右键菜单　　



1、　　　　　　　　列出工作表标签按右键出现的〃快显功能表〃　　

2、　　　　　　　　Sub　test（）　　

3、　　　　　　　　k　=　Application。mandBars（〃Ply〃）。Controls。Count　　

4、　　　　　　　　For　i　=　1　To　k　　

5、　　　　　　　　　　MsgBox　　　　　　　　　　　　　〃Id：〃　　　　　　　　　　&　　　　　　　　　　　　i　　　　　　　　　　&　　　　　　　　　　　Chr（13）　　　　　　　　　　　　&　　

　　　　Application。mandBars（〃Ply〃）。Controls（i）。Caption　　

6、　　　　　　　　Next　i　　

7、　　　　　　　　End　Sub　　

8、　　　　　　　　列出工具栏快显菜单　　

9、　　　　　　　　Sub　ListShortCut