我有一个小的用户窗体(Outlook),可以显示选定的电子邮件。 由于列表框的列标题中不能包含文本,因此我修改了建议的here解决方案。
我的问题:
初始化表格后,页眉框位置错误,尺寸错误。一些检查表明,正确的值是由函数createListboxHeader()分配的,并且没有错误。但是,在该功能(初始化后返回)之后检查页眉盒的位置和大小,值是错误的-证明我所看到的。
奇怪:有时它可以正常工作,但在大多数情况下不是。
有人暗示这里可能有什么问题吗?非常感谢!
代码:
Public Sub createListboxHeader(lstBody As ListBox, arrHeaders)
Dim lstHeader As ListBox
Dim i As Integer
'create new listbox for the header
Set lstHeader = Me.Controls.Add("Forms.ListBox.1","NameOnlyForTesting")
With lstBody
'ensure properties of body-listbox
.ColumnHeads = False
.ZOrder (1)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
With lstHeader
'properties of header-listbox
.BackColor = RGB(200, 200, 200)
.Enabled = False
.ZOrder (0)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
'make column equal
.ColumnCount = lstBody.ColumnCount
.ColumnWidths = lstBody.ColumnWidths
'add header elements
.AddItem
For i = 0 To UBound(arrHeaders)
.List(0, i) = arrHeaders(i)
Next i
'positioning of header-listbox
.Height = 10
.Width = lstBody.Width
.Left = lstBody.Left
.Top = (lstBody.Top - lstHeader.Height) - 0
Debug.Print lstBody.Width, lstHeader.Height ' <-- show both '400'
End With
End Sub
用法:
Private Sub UserForm_Initialize()
'find emails
Dim selEmails As Outlook.Selection
Set selEmails = getSelectedEmails() 'function not displayed here at StackOverflow
'show emails in List-Box
Call printSelectedEmailsInList(selEmails)
End Sub
Private Sub printSelectedEmailsInList(selectedEmails As Outlook.Selection)
Dim objEmail As Outlook.MailItem
Dim intCounter As Integer
Dim arrHeaders() As Variant
With Me.lstSelectedEmails
'configure listbox
.Clear
.ColumnCount = 5
.ColumnWidths = "70;100;100;200;100"
'configute header (AFTER body!)
arrHeaders = Array("Date", "From", "To", "Subject", "Folder")
Call createListboxHeader(Me.lstSelectedEmails, arrHeaders)
MsgBox Me.Controls("NameOnlyForTesting").Width '<-- shows'78' instead of '400'
'fill list with emails
intCounter = 0
For Each objEmail In selectedEmails
.AddItem
.List(intCounter, 0) = objEmail.SentOn
.List(intCounter, 1) = objEmail.SenderName
.List(intCounter, 2) = objEmail.To
.List(intCounter, 3) = objEmail.Subject
.List(intCounter, 4) = objEmail.Parent.Name
intCounter = intCounter + 1
Next
End With
End Sub
答案 0 :(得分:0)
我通过更改解决了我的问题:
Private Sub UserForm_Initialize()
[...]
End Sub
收件人:
Private Sub UserForm_Activate()
[...]
End Sub