Exce边线l处理

Private   Sub   Command1_Click()
        Dim   MyExe   As   Excel.Application
        Dim   Wbk   As   Workbook
        Dim   Sht   As   Worksheet
        Set   MyExe   =   GetObject(,   "excel.application ")
        Set   Wbk   =   MyExe.ActiveWorkbook
        Set   Sht   =   Wbk.ActiveSheet
        With   Sht.Range( "a1:a2 ")   '确定目标区域
                .HorizontalAlignment   =   xlCenter   '水平居中
                .Merge   '合并
                '下面为4条边线
                .Borders(xlEdgeLeft).LineStyle   =   xlContinuous
                .Borders(xlEdgeTop).LineStyle   =   xlContinuous
                .Borders(xlEdgeBottom).LineStyle   =   xlContinuous
                .Borders(xlEdgeRight).LineStyle   =   xlContinuous
                '下面为斜线
                .Borders(xlDiagonalDown).LineStyle   =   xlNone
                .Borders(xlDiagonalUp).LineStyle   =   xlNone
                .Font.Bold   =   True   '设为粗体
        End   With
        Set   Sht   =   Nothing
        Set   Wbk   =   Nothing
        Set   MyExe   =   Nothing
End   Sub

使用语句：

Set MyRng=range(“A1:B3”)

MyArr=MyRng

结果如下：

MyArr(1,1)=1

MyArr(1,2)=”x”

MyArr(2,1)=2

MyArr(2,2)=”y”

MyArr(3,1)=3

MyArr(3,2)=”z”

 

多块区域只保留代码中出现的第一部分。对Range对象MyRng1,MyRng2,MyRng3 使用语句

MyArr=Range(MyRng1,MyRng2,MyRng3)

将会与

MyArr=MyRng1

是等价的。这意味着使用Range(“A1:A3,B1:B2”)，Range(“A1:B2,A3”)及Range(“B1:B2,A1:B3”)进行赋值都是不一样的，大家请自行验证。

这意味着语句MyArr=Range(“A1:A10”)等价于以下代码

For i=1 to 10

         MyArr(i,1)=Range(“A”& i)

         Next i

语句MyArr=Range(“A1:J1”)等价于以下代码

         For i=1 to 10

                   MyArr(1,i)=Cells(i,1)

Next i

矩形区域的解析。使用 M 行 *N 列矩形区域将会产生形如 MyArr(1 to M,1 to N) 型二维数组。注意生成的数组的上标始终为 1，不受Option Base语句影响。

 

数组的输出，需要指定输出单元格区域的大小，在不转置的情况下，MyArr(1 to M,1 to N)型数组需要一个M行*N列区域来完全容纳。如果指定的输出区域大于M行*N列，多出的区域将会以”#N/A”填充；如果指定的输出区域小于M行*N列，那么数组元素将得不到完整的显示。

单列数组，即MyArr(1 to M,1 to 1)型数组的输出经常被使用到，将其输出到以[A1]为首的A列，使用语句

Range(“A1:A” & M)=MyArr

输出到以[A1]为首的第1行，需要使用工作表函数Transpose，如下

Range(Cells(1,1),Cells(N,1))=WorksheetFunction.Transpose(MyArr)

实际上大家马上看出来单元格区域的描述可以使用Range的Resize属性来完成，如下

Range(“A1”).Resize(M,1)=MyArr

Range(“A1”).Resize(1,M)=WorksheetFunction.Transpose(MyArr)

对多列区域可以在不知道数组的下标的情况下使用Ubound函数或者源单元格区域的Range属性或获取输出单元格区域的范围，如下

Range(“A1”).Resize(Ubound(MyArr,1), Ubound(MyArr,2))=MyArr

Range(“A1”).Resize(MyRng.Rows.Count, MyRng.Columns.Count)=MyArr

ReDim的使用仍然相同，注意ReDim语句后的数组上标受Option Base语句控制；ReDim Preserve语句失效，提示下标越界

 

 

移除文件菜单中保存、另存、另存为WEB页、WEB页预览、打印预览、打印等项：  
          Application.CommandBars("File").Controls(12).Delete  
          Application.CommandBars("File").Controls(11).Delete  
          Application.CommandBars("File").Controls(8).Delete  
          Application.CommandBars("File").Controls(7).Delete  
          Application.CommandBars("File").Controls(6).Delete  
          Application.CommandBars("File").Controls(5).Delete  
          Application.CommandBars("File").Controls(4).Delete  
  恢复：  
          Application.CommandBars("File").reset  
  '删除编辑菜单：  
          Application.CommandBars("Worksheet   Menu   Bar").Controls(2).Delete  
  '恢复编辑菜单：  
          Application.CommandBars("worksheet   menu   bar").Reset  
   
   
  '关于右键菜单请见：  
  http://community.csdn.net/Expert/topic/4228/4228120.xml?temp=.2959711  
   
   
   
  '删除工具栏中保存、打印、打印预览、剪切按钮：  
          Application.CommandBars("Standard").Controls(8).Delete  
          Application.CommandBars("Standard").Controls(6).Delete  
          Application.CommandBars("Standard").Controls(5).Delete  
          Application.CommandBars("Standard").Controls(3).Delete  
  '恢复：  
  Application.CommandBars("Standard").Reset

 

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    EnableControl 3, False   ' 禁用保存命令
    EnableControl 752, False   ' 禁用退出命令
    Application.OnKey "^{s}", "" '禁用ctl+s保存快捷键
    SystemMenu_DeleteClose '禁用程序关闭按钮
    SystemMenu_DeletebkClose '禁用工作簿关闭按钮
End Sub

 

1、我想屏蔽掉“常用”工具栏和文件菜单下的保存按钮的功能，也不能用“Ctrl+s”组合键保存，按“×”好后即关闭excel，不提示也不做保存，应如何做？

2、怎样在一列里“禁止输入重复值，否则提示：“对不起，不能重复输入！”，按确定后将第二个重复值自动删除掉！

 

第一个问题：
'------------------------------------------------------ThisWorkbook------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Me.Saved = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
End Sub

第二个问题：

'---------------------------------------------------------Sheet1---------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count = 1 Then
            If .Column = 1 And len(.Value) >0 And Application.WorksheetFunction.CountIf(colums(1), .Value) > 1 Then
                Application.EnableEvents = False
                Target = ""
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub