用VB6的COM 外接程序编写设置自动换行的com加载项

三戒

Option Explicit  
Private WithEvents objExcelApp As Excel.Application  
Private WithEvents objButton As Office.CommandBarButton  

'========================================================================
    ''启动时执行的任务
'========================================================================
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)  
Set objExcelApp = Application  
If CInt(objExcelApp.Version) < 12 Then  
   Call CreateMenu   '如果是2007及以上的版本，则不支持
Else  
   objExcelApp.COMAddIns("ExcelCellWrapText.Connect").Connect = False   '取消链接
   Set objExcelApp = Nothing   '否则取消关联
End If  
End Sub  
'========================================================================
    '移除时执行的任务
'========================================================================
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)  
  Call DeleteMenu  
  Set objButton = Nothing  
  Set objExcelApp = Nothing  
End Sub  

'========================================================================
    '创建按钮和关联对象
'========================================================================

Private Sub CreateMenu()  
    Call DeleteMenu  
      'objExcelApp.CommandBars("Formatting").Visible = True
    Set objButton = before:=10, Temporary:=True)  
    With objButton  
      .Caption = "自动换行"  
      .Visible = True  
      .FaceId = 194  
      .Style = msoButtonIconAndCaption  
      .Tag = "objButton1"  
  End With  
End Sub  

'========================================================================
    '删除按钮
'========================================================================

Private Sub DeleteMenu()  
    On Error Resume Next  
      'CommandBars(1).Reset
     
End Sub  



'========================================================================
    '按钮的动作
'========================================================================

Private Sub objButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)  
On Error GoTo RangeErr  
  objExcelApp.Selection.WrapText = Not objExcelApp.Selection.WrapText  
  With objButton  
    If .State = msoButtonDown Then  
       .State = msoButtonUp  
    ElseIf .State = msoButtonUp Then  
       .State = msoButtonDown  
    End If  
  End With  
RangeErr:  
   If Err.Number = "1004" Then MsgBox "该工作表有保护，请取消工作表保护后再设置自动换行！", vbExclamation, Title:="请检查！"  
End Sub  

'========================================================================
    '切换工作表时的检测
'========================================================================
Private Sub objExcelApp_SheetActivate(ByVal Sh As Object)  
  If objExcelApp.ActiveCell.WrapText = True Then  
    objButton.State = msoButtonDown  
  Else  
    objButton.State = msoButtonUp  
  End If  
End Sub  

'========================================================================
    '切换单元格区域时的检测
'========================================================================

Private Sub objExcelApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)  
If Target.WrapText = True Then  
    objButton.State = msoButtonDown  
  Else  
    objButton.State = msoButtonUp  
  End If  
End Sub  
'========================================================================
    '切换工作簿时的检测
'========================================================================
Private Sub objExcelApp_WorkbookActivate(ByVal Wb As Excel.Workbook)  
  If objExcelApp.ActiveCell.WrapText = True Then  
    objButton.State = msoButtonDown  
  Else  
    objButton.State = msoButtonUp  
  End If  
End Sub  

'========================================================================
    '关闭工作簿时的检测
'========================================================================
Private Sub objExcelApp_WorkbookDeactivate(ByVal Wb As Excel.Workbook)  
  If objExcelApp.Workbooks.Count = 1 Then objButton.State = msoButtonUp  
End Sub

wjhere

原帖由 三戒 于 2009-8-4 17:47 发表
在安装有office 2003的机器上试了一下，可以运行

切换文档就不行了，我的机器有问题？

aidixiao

谢谢分享。

wangfengcpa

这么好的文章，我今天才看到，失败失败啊。

pkingson

学习中学习中学习中

lanceflyliu

我就看一下就行了，现在还不到这个水平，我得好好的向各位学习

qsdys

谢谢分享。收藏了，谢谢

wl9643

谢谢楼主，我想问一下，如何添加菜单而不是工具栏按钮。

lishucheng96

If CInt(objExcelApp.Version) < 12 Then  
   Call CreateMenu   '如果是2007及以上的版本，则不支持
Else  
   objExcelApp.COMAddIns("ExcelCellWrapText.Connect").Connect = False   '取消链接
   Set objExcelApp = Nothing   '否则取消关联
End If  

为什么2007及以上版本不能支持呢？可不可以将“12”设置为更高值？还是由于版本问题不兼容？

wxhnr

原帖由 lishucheng96 于 2011-3-21 11:57 发表
If CInt(objExcelApp.Version) < 12 Then  
   Call CreateMenu   '如果是2007及以上的版本，则不支持
Else  
   objExcelApp.COMAddIns("ExcelCellWrapText.Connect").Connect = False   '取消链接
   Set objE ...

楼主讲了，2007中这个自动换行的按钮就在界面上，2003的隐藏较深。