列表框复制到剪贴板并保留列

时间:2020-04-28 13:56:10

标签: excel vba listbox clipboard

在我的用户窗体中,用户选择一些选项,当他们播放cmd时,我的列表框将显示结果。

现在我需要将列表框数据复制到剪贴板中,并且可以使用此代码来完成!

Private Sub BtnCopy_Click()
Dim iCol As Integer
Dim strList As String
Dim i As Integer
Dim MyData As DataObject

For i = 0 To Me.lbResult.ListCount - 1
    If Len(Trim(Me.lbResult.List(i))) > 0 Then ' blank values excluded here
       For iCol = 0 To lbResult.ColumnCount - 1
           strList = strList & Trim(FrmPrice.lbResult2.List(i, iCol)) & vbTab
       Next
       strList = strList & vbCrLf
    End If
Next i


Set MyData = New DataObject
MyData.Clear
MyData.SetText strList
MyData.PutInClipboard
End Sub

对,但是当我将数据粘贴到正文邮件中时,这就是结果

Pays    City    Cap Q.li    €_STD   €_NEW   Delta   
DE  ACHERN/BADER    DE_77   11  179,85  284,85  105 

我的目标是将文本变成这样的“列”:

Pays    City            Cap     Q.li    €_STD   €_NEW   Delta   
DE      ACHERN/BADER    DE_77   11      179,85  284,85  105 

有一种从列表框复制/提取数据以保持列空间的方法吗?

我也尝试了这种解决方法,当我为列表框准备数据时,我“设置”了长度

Private Sub btnEval_Click()

Dim tax As Long, qle As Double, spe As Double
Dim oupt(0 To 1, 0 To 6)

    Me.lbResult.Clear

oupt(0, 0) = "Pays"                         'filed lenght 4
oupt(0, 1) = "City" & String(16, " ")       'filed lenght 20
oupt(0, 2) = "Cap" & String(3, " ")         'filed lenght 6
oupt(0, 3) = "Q.li" & String(4, " ")         'filed lenght 8
oupt(0, 4) = "€_STD" & String(3, " ")         'filed lenght 8
oupt(0, 5) = "€_NEW" & String(3, " ")         'filed lenght 8
oupt(0, 6) = "Delta" & String(3, " ")         'filed lenght 8

oupt(1, 0) = cbCountry.List(cbCountry.ListIndex, 0) & String(Application.Min(4, Len(oupt(1, 0))), " ")
oupt(1, 1) = cbCity.List(cbCity.ListIndex, 0) & String(Application.Min(20, Len(oupt(1, 1))), " ")
oupt(1, 2) = cbCap.List(cbCap.ListIndex, 1) & String(Application.Min(6, Len(oupt(1, 2))), " ")
oupt(1, 3) = tax / 100 & String(Application.Min(8, Len(oupt(1, 3))), " ")
oupt(1, 4) = Application.Max(qle, spe) & String(Application.Min(8, Len(oupt(1, 4))), " ")
oupt(1, 5) = Round(Me.NewPrice2 * 1.055, 2) & String(Application.Min(8, Len(Application.Min(1, 5))), " ")
oupt(1, 6) = Round(Me.NewPrice2 * 1.055, 2) - Application.Max(qle, spe) & String(Application.Min(8, Len(oupt(1, 6))), " ")

    AddItemLb2 (oupt)

errorHandler:

End Sub

Private Sub AddItemLb(ByVal arr)
    With lbResult
        .Clear
           .AddItem
           .List = arr
        .ListIndex = -1
    End With
End Sub

但这不是正确的方法,结果不会改变。

Pays    City    Cap Q.li    €_STD   €_NEW   Delta   
DE  ACHERN/BADER    DE_77   11  179,85  284,85  105 

感谢任何建议

fabrizio

0 个答案:

没有答案
相关问题