[讨论]将RSS Feed 的内容展示在[工作窗格]征求测试

很多网站都参与了Google AdSense 计划，本范例做了一个类似 Google AdSense 广告工具，在工作窗格中[CommandBars("Task Pane")]展示我的网站的内容，打一下广告。本范例做了一个监控的程式，当[CommandBars("Task Pane")]关闭时会自动关闭RSS Feed，本范例采用 UFT-8 编码可以在繁简体中显示。利用ㄧ点时间做出来的 RSS Feed Reader ，在我的电脑已测试 OK 请各位网友帮忙测试看看1.Userform 在 工作窗格中[CommandBars("Task Pane")]中的位置是否正确?2.在简体环境，文字是否会变成乱码? 请测试过的网友回覆一下 谢谢您的测试!原始网页:http://www.vba.com.tw/plog/post/1/274'ThisworkbookPrivate Sub Workbook_BeforeClose(Cancel As Boolean)Unload ExcelVBAFormApplication.CommandBars("Task Pane").Visible = FalseSet colCBars = NothingEnd SubPrivate Sub Workbook_Open()If IsNetConnectOnline = False ThenMsgBox "Online Music 侦测到本机无法连线到网路" & vbCrLf & _"程式无法启动"End IfExcelVBAFormShowEnd Sub'ModulePublic Declare Function FindWindowEx Lib "user32.dll" _Alias "FindWindowExA" (ByVal hWnd1 As Long, _ByVal hWnd2 As Long, ByVal lpsz1 As String, _ByVal lpsz2 As String) As LongPublic Declare Function InternetGetConnectedState _Lib "wininet.dll" (ByRef dwflags As Long, _ByVal dwReserved As Long) As LongPublic Const INTERNET_CONNECTION_MODEM As Long = &H1Public Const INTERNET_CONNECTION_LAN As Long = &H2Public Const INTERNET_CONNECTION_PROXY As Long = &H4Public Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8Public Const INTERNET_RAS_INSTALLED As Long = &H10Public Const INTERNET_CONNECTION_OFFLINE As Long = &H20Public Const INTERNET_CONNECTION_CONFIGURED As Long = &H40Public clsvbaClass As New clsvbaEvents'引用clsvbaEvents物件模组Public vbahwnd As LongSub ExcelVBAFormShow()ExcelVBAForm.Show 0End SubSub vbDHTMLEditText()Dim mi As Integer, mk As Integer'读入 Html 语法With ThisWorkbookFor mi = 1 To 65Html = Html & .Sheets("code").Cells(mi, 1).Text & vbCrLfNext miWith ExcelVBAForm.DHTMLEdit1.BrowseMode = True: .ScrollBars = False.DocumentHTML = HtmlDo While .Busy: DoEvents: LoopEnd WithEnd WithEnd SubFunction CbarHwnd(sCaption$) As Long'取得CommandBar 的HandleDim h&(2)'使用类别名称"XLMAIN"来取得 Excel's main window handleh(0) = FindWindowEx(0, 0, "XLMAIN", Application.Caption)Do While h(0)'使用类别名称"EXCEL2"来取得 Commandbar areaHandleh(1) = FindWindowEx(h(0), h(1), "EXCEL2", vbNullString)DoDoEvents'使用类别名称"MsoCommandBar"来取得 Commandbar Handleh(2) = FindWindowEx(h(1), h(2), "MsoCommandBar", sCaption$)If h(2) Then GoTo theEndLoop Until h(2) = 0LooptheEnd:CbarHwnd = h(2)End FunctionSub InitEvents()' CommandBars 物件引用给clsvbaEvents物件模组中的物件变数colCBarsSet clsvbaClass.colCBars = Application.CommandBarsEnd SubFunction IsNetConnectOnline() As Boolean'如果有任何的型态一个连接，传回 TrueIsNetConnectOnline = InternetGetConnectedState(0&, 0&)End Function'UserformPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _ByVal nIndex As Long) As LongPrivate Declare Function SetParent Lib "user32" _(ByVal hWndChild As Long, _ByVal hWndNewParent As Long) As LongPrivate Sub UserForm_Initialize()Dim vblngMe As LongDim cbrh As IntegerApplication.CommandBars("Task Pane").Visible = Falsecbrh = Application.CommandBars(1).Height * 0.75 + 2xOffset = (Me.Width - Me.InsideWidth) / 2yOffset = Me.Height - Me.InsideHeight - xOffsetvbahwnd = FindWindow(vbNullString, Me.Caption)'该函数获得有关指定窗口的信息'-16:获得窗口风格'WS_CAPTION As Long = &HC00000'(标题)vblngMe = GetWindowLong(vbahwnd, -16) And Not &HC00000'去标头SetWindowLong vbahwnd, -16, vblngMe: DrawMenuBar vbahwnd''获得扩展窗口风格vblngMe = GetWindowLong(vbahwnd, -20) And Not &H1&'去边框SetWindowLong vbahwnd, -20, vblngMeMe.DHTMLEdit1.Width = Application.CommandBars("Task Pane").Width * 0.75 + 2Me.DHTMLEdit1.Height = Application.CommandBars("Task Pane").Height * 0.75Me.Width = Me.DHTMLEdit1.WidthMe.Height = Me.DHTMLEdit1.Height + 2Me.Top = Me.Top + xOffset + 2 + cbrhMe.Left = Me.Left + xOffsetCall vbDHTMLEditTextWith Application.CommandBars("Task Pane").Visible = True.Width = 250SetParent vbahwnd, CbarHwnd(.NameLocal)End WithCall InitEventsEnd Sub'ClassPublic WithEvents colCBars As Office.CommandBarsPrivate Sub colCBars_OnUpdate()With colCBars.Item("Task Pane")If .Visible = False ThenUnload ExcelVBAForm.Visible = FalseSet colCBars = NothingEnd IfIf .Width250 ThenDoEvents.Width = 250Call ExcelVBAFormShowEnd IfEnd WithEnd Sub档案下载:http://www.vba.com.tw/file/H0059.rarPS:要记得回报哦!

[此贴子已经被作者于2006-2-19 15:18:25编辑过]

To chijanzen :我这打开出现这个:document.body.clientWidth*0.5) {this.resized=true;this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" />

skylark你好:感谢你的测试请问你的Excel版本?还有错误在哪一句程式码呢?

To chijanzen :

不要客气,我们也有学习的机会.

我的版本是:WindowsXP+Office2003,出错在:(蓝色字体).

Sub ExcelVBAFormShow()
ExcelVBAForm.Show 0
End Sub

你好:应该不会在 ExcelVBAForm.Show 0 这句你可以按 F8键继续执行下去吗?还有你可以试试 MsgboxApplication.CommandBars("Task Pane").Visible 这句吗?

To chijanzen :

可以按住F8运行,一点时间运行后重又出现如上贴的报错,还可再按调试回到VBE,接按F8后又回到报错.

MsgboxApplication.CommandBars("Task Pane").Visible 放在:ExcelVBAForm.Show 0 前,是False,

放在:ExcelVBAForm.Show 0 后,也是False.

请再试试Application.CommandBars("Task Pane").Visible=True这句可以运行吗?你应该是这句运行错误?

To chijanzen :放在立即窗口回车为:document.body.clientWidth*0.5) {this.resized=true;this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" />费心了,可以等其他,网友试用,也许我这儿有什么不对.

你好:

很奇怪你的电脑无法运行 Application.CommandBars("Task Pane").Visible = True

我就没办法了?

先決條件已有 "工作窗格"

..document.body.clientWidth*0.5) {this.resized=true;this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" />

skylark:

****已解决Excel 启动时[工作窗格]无法自动启动的问题************

请重新下载，感谢您的测试 http://www.vba.com.tw/plog/post/1/274

感谢 Emily 的测试，请重新下载档案

谢谢!

WinXP+Excel2003简体中文下，暂时没发现错误提示。

不过不知道 工作窗格中的图标是什么了。偶这里显示的是个白色小框框。

关闭 防火墙 可以看到全部的列表显示了。

下载地址失效了啊，楼主重贴下代码吧