VBA编程问答(第4辑)

fanjy 发表于 2007-2-8 11:26:00
在学习ExcelVBA编程的过程中，经常会遇到一些问题，有些可能是新碰到的，有些则是以前已遇到过但暂时忘掉了解决办法的，VBA编程问答将把我所收集到的问题和自已所遇到的问题及解决办法进行归纳整理，以方便查阅和参考。
在下面的内容中，有大量的程序代码，并附有简单的说明，您可以将它们输入或复制到VBE编辑器中进行调试，也可以将它们进行适当的调整和修改后应用到自已的程序中。有些问答提供了参考示例，您可以直接下载后处理。
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
本辑目录：
问题32：如何删除工作簿中的所有链接？
问题33：如何实现工程不可查看？
问题34：如何判断并根据条件删除行？
问题35：如何在不同的工作表之间进行复制？
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
问题32：如何删除工作簿中的所有链接？
解答：可以用以下的代码来完成：
Sub RemoveHyperlinks()
Dim hl As Hyperlink
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
For Each hl In ws.Hyperlinks
hl.Delete
Next hl
Next ws
End Sub
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
问题33：如何实现工程不可查看？
解答：使【工程不可查看】的两种实现方法：
在VBE里如何使自己的成果得到一定的保护呢?大家都知道,运用EXCEL本身提供的各级口令保护功能就可以对文档实施加密操作,可是这种口令保护十分脆弱(网上诸如此类暴力破解多如牛毛...).所以大多数VBE用户选择较多的就是如下这种加密方式(【工程不可查看】)：
方法一（共享级锁定）：
1、先对EXCEL文件进行一般的VBAProject工程密码保护。
2、打开要保护的文件，选择：工具--->保护--->保护并共享工作簿--->以追踪修订方式共享-->输入密码-->保存文件。
完成后，当你打开“VBAProject”工程属性时，就将会提示：“工程不可看！“
破解方法：用这种办法的话，只要找出工作表的密码保护，相应的工程就可以查看了，还不如用第二种方法的好!
方法二（推荐，破坏型锁定）：
用16进制编辑工具，如WinHex、Ultraedit-32等，再厉害点的人完全可以用debug命令来做......用以上软件打开EXCEL文件，查找定位以下地方：
ID="{00000000-0000-0000-0000-000000000000}" 注：实际显示不会全部为0
此时，你只要将其中的字节随便修改一下即可。保存再打开，就会发现大功告成！
当然，在修改前最好做好你的文档备份。至于恢复只要将改动过的地方还原即可（只要你记住了呵呵）。
顺便说一句，这种方法仍然是可破解的，因为加密总是相对的。
破解方法：将CMG=，DPB=和GC=后的"="替换为"."也可以的，我已测试过的确可以。
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
问题34：如何判断并根据条件删除行？
问题：有一个工作簿，其中有N张sheet，要做到：遍历所有sheet中指定列的值，如果该单元格的值为1，则什么都不做，如果为0，则删除此行。
解答：作下面的代码试试，注意，在试验之前先备份工作簿。
Sub DeleteRow(C As Integer)
'指定一个列的数字，把所有工作表中该列数值为0的行删除
Dim sh As Worksheet
Dim rg As Range
For Each sh In ThisWorkbook.Worksheets
Set rg = sh.Cells(65536, C).End(xlUp)
Do While rg.Row >= 2
If rg.Value = 0 Then
Set rg = rg.Offset(-1, 0)
rg.Offset(1, 0).EntireRow.Delete
Else
Set rg = rg.Offset(-1, 0)
End If
Loop
Next
Set sh=Nothing
Set rg=Nothing
End Sub
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
问题35：如何在不同的工作表之间进行复制？
问题：请问如何用函数将表格1自动复制至表格2对应的页？例如：我想将表格1对应的1、2、3、4复制至表格2对应1、2、3、4时，它会按要求自动复制，同时，当我想将表格1对应1、2复制至表格2对应1、2，表格1其余3、4不想同时复制，怎样可以做到呢？
解答：(陈希章)
至少有两个同时打开的工作簿，受保护的工作表不能被复制（自动被隐藏掉了）。
如图，在某个工作表中制作如下窗体：

相应代码如下：
Private Sub cb1_Change()
Dim ws As Worksheet
If cb1.ListIndex <> -1 Then
Lst1.Clear
For Each ws In Workbooks(cb1.Value).Worksheets
If ws.ProtectContents = False Then Lst1.AddItem ws.Name
Next
Else
Lst1.Clear
End If
End Sub
Private Sub cb2_Change()
Dim ws As Worksheet
If cb2.ListIndex <> -1 Then
lst2.Clear
For Each ws In Workbooks(cb2.Value).Worksheets
If ws.ProtectContents = False Then _
lst2.AddItem ws.Name
Next
Else
lst2.Clear
End If
End Sub
Private Sub cmdadd_Click()
Dim n As Integer
If Lst1.ListIndex <> -1 And lst2.ListIndex <> -1 Then
If cb1.Value <> cb2.Value Then
lst3.AddItem cb1.Value
n = lst3.ListCount - 1
lst3.List(n, 1) = Lst1.Value
lst3.List(n, 2) = "=>"
lst3.List(n, 3) = cb2.Value
lst3.List(n, 4) = lst2.Value
Else
MsgBox "必须选择两个不同的工作簿", vbExclamation, "错误"
End If
Else
MsgBox "必须先选择两个工作表", vbExclamation, "错误"
End If
End Sub
Private Sub cmddelete_Click()
Dim n As Integer
n = lst3.ListIndex
If n <> -1 Then
lst3.RemoveItem n
Else
MsgBox "请先选择一个要删除的条件", vbExclamation, "错误"
End If
End Sub
Private Sub cmdgo_Click()
Dim n As Integer, m As Integer
Dim sws As Worksheet, dws As Worksheet
n = lst3.ListCount
If n > 0 Then
For m = 0 To n - 1
Set sws = Workbooks(lst3.List(m, 0)).Worksheets(lst3.List(m, 1))
Set dws = Workbooks(lst3.List(m, 3)).Worksheets(lst3.List(m, 4))
sws.Cells.Copy dws.Cells
Next
MsgBox "复制完毕", vbInformation, "报告"
Else
MsgBox "没有需要执行的任务", vbExclamation, "错误"
End If
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wb As Workbook
Dim n As Integer
n = Application.Workbooks.Count
If n = 1 Then
cb1.Enabled = False
cb2.Enabled = False
Lst1.Enabled = False
lst2.Enabled = False
cmdadd.Enabled = False
cmddelete.Enabled = False
cmdgo.Enabled = False
MsgBox "当前只有一个工作簿", vbExclamation, "错误"
Exit Sub
Else
For Each wb In Application.Workbooks
cb1.AddItem wb.Name
Next
cb1.Value = ThisWorkbook.Name
cb2.List = cb1.List
End If
End Sub
示例文件：不同工作表之间的复制
注：本辑程序摘选自dicks-blog、微软中国社区。
分类:ExcelVBA>>VBA编辑问答专辑
By fanjy in 2007-2-8