[组装]【聚宝瓶】邻家有女初长成--我的工具箱

hhzjxss

<br/>Sub 删除空行()''''引用小刀的代码<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/><br/>&nbsp;&nbsp;&nbsp; Dim RowID As Integer<br/>&nbsp;&nbsp;&nbsp; Dim sMessage As String<br/>&nbsp;&nbsp;&nbsp; Application.ScreenUpdating = False<br/>&nbsp;&nbsp;&nbsp; ' * 错误源<br/>&nbsp;&nbsp;&nbsp; Dim sSource As String<br/>&nbsp;&nbsp;&nbsp; On Error GoTo Err_Handler<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For RowID = Range(Cells(1, 1), ActiveSheet.UsedRange).Rows.Count To 1 Step -1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Application.WorksheetFunction.CountBlank(Rows(RowID).EntireRow) = 256 Then ''工作表函数CountBlank(行号)，计算该行空白单元格的数目<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Rows(RowID).Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>Exit_Label:<br/>&nbsp;&nbsp;&nbsp; On Error GoTo 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Exit Sub<br/>Err_Handler:<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sMessage = "运行出错！" &amp; vbCrLf _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &amp; Err.Description<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' * 显示友好的错误信息<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call MsgBox( _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Prompt:=sMessage, _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Buttons:=vbExclamation)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo Exit_Label<br/>&nbsp;&nbsp;&nbsp; Application.ScreenUpdating = True<br/>End Sub<br/>

ygaaaa43

好的东西,

hhzjxss

<p><font size="4">刚才在看自己博客的时候，感觉</font><a id="ImgSpan" href="http://www.excelpx.com/UploadFile/2008-2/20082281945786636.bmp" target="_blank"></a><font size="4">图片就能打开QQ和对方交流的东东很好玩！</font></p><p><font size="4">刚才把内容复制过来，发现也可以打开，共享一下！</font></p><p><br/></p><p><a href="http://www.excelpx.com/forum.php?mod=viewthread&tid=39488&extra=&page=1#39488">http://www.excelpx.com/forum.php?mod=viewthread&tid=39488&extra=&page=1#39488</a></p>

hhzjxss

<p>这样改一下就可以输入你想要聊天的人的号码了！</p><p>Sub QQ聊天()<br/>&nbsp;&nbsp;&nbsp; Dim str As String<br/>&nbsp;&nbsp;&nbsp; str = InputBox("请输入对方的QQ号码！", "QQ聊天", "313755341")<br/>&nbsp;&nbsp;&nbsp; If str = "" Then Exit Sub<br/>&nbsp;&nbsp;&nbsp; CreateObject("InternetExplorer.Application").Navigate "<a href="http://wpa.qq.com/msgrd?V=1&amp;amp;Uin">http://wpa.qq.com/msgrd?V=1&amp;amp;Uin</a>=" &amp; str &amp; "&amp;amp;Menu=yes"<br/>End Sub<br/></p>

wangw_q

等待雨版分享

工＆贝

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>hhzjxss</i>在2008-2-20 13:17:00的发言：</b><br/><p>有时间倒是想搞个“工程应用聚宝瓶”，将excel在工程测量、设计、建设管理、施工、监理、预算等方面的东东搞一个工具箱出来。</p><p>只是难以有时间实现。再说水平也不够，只好先搞个组装的玩玩！</p>[em04]</div><p></p>好啊，期待雨版

hhzjxss

<p>今天网速有些慢</p><p>来一个用菜单加载菜单 的！</p><p>&nbsp;</p><p><br/></p><p><a href="http://www.excelpx.com/forum.php?mod=viewthread&tid=39484&amp;replyID=39484">http://www.excelpx.com/forum.php?mod=viewthread&tid=39484&amp;replyID=39484</a></p>

mxg825

雨版的好东东，真多！[em02][em02]

hhzjxss

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>mxg825</i>在2008-3-1 13:41:00的发言：</b><br/>雨版的好东东，真多！[em02][em02]</div><p>摸石头过河！</p>

妩媚青山

真厉害！