1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
|
Imports System
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Reflection ' For Missing.Value and BindingFlags
Imports System.Runtime.InteropServices ' For COMException
Imports OXL = Microsoft.Office.Interop.Excel 'alias d'excel interop
Public Class frmMartin
Public Sub New()
' Cet appel est requis par le concepteur.
InitializeComponent()
' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
' Disable automatic sorting to enable manual sorting.
Me.ListView1.Sorting = SortOrder.None
Me.ListView1.View = View.Details
' Add 4 columns and set their text.
Me.ListView1.Columns.Add(New ColumnHeader)
Me.ListView1.Columns(0).Text = "Auteur "
Me.ListView1.Columns(0).Width = 100
ListView1.Columns.Add(New ColumnHeader)
ListView1.Columns(1).Text = "Titre "
End Sub
Private Sub btnLoadItems_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoadItems.Click
' Cree les ListViewItems .
Dim ListLVItem As List(Of ListViewItem) = New List(Of ListViewItem)
Dim LVItem As ListViewItem
Dim sn As String
For k As Integer = 0 To 270
sn = (k + 1).ToString
LVItem = New ListViewItem(New String() {"Auteur" & sn, "Titre" & sn}, -1, Color.Empty, Color.Yellow, Nothing)
ListLVItem.Add(LVItem)
Next
'Add Items
Me.ListView1.Items.AddRange(ListLVItem.ToArray)
' Set the location and size of the ListView control.
Me.ListView1.Name = "listView1"
Me.ListView1.TabIndex = 0
' Enable editing of the items in the ListView.
Me.ListView1.LabelEdit = True
Me.ListView1.MultiSelect = True
Me.ListView1.FullRowSelect = True
End Sub
Private Sub btnCopyToWorkBook_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCopyToWorkBook.Click
Automation_UseArrayBIS()
End Sub
Private appChemin As String = Directory.GetCurrentDirectory & "\"
Private monFichier As String = "book.xls"
Private Sub Automation_UseArrayBIS()
'Cree un DataArray .
Dim nbLine As Integer = Me.ListView1.Items.Count
Dim nbColumn As Integer = Me.ListView1.Items.Item(0).SubItems.Count
Dim DataArray(nbLine, nbColumn) As String
For i As Integer = 0 To Me.ListView1.Items.Count - 1
For j As Integer = 0 To Me.ListView1.Items(i).SubItems.Count - 1
DataArray(i, j) = Me.ListView1.Items(i).SubItems(j).Text
Next
Next
Dim appExcel As OXL.Application
Dim wBook As OXL.Workbook
Dim wSheet1 As OXL.Worksheet
Dim wSheet2 As OXL.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
'if Excel is already running ,close it.
If appExcel IsNot Nothing Then
releaseObject(appExcel)
' Force .NET to perform garbage collection.
System.GC.Collect()
End If
Try
'Start a new workbook in Excel.
appExcel = New OXL.Application
wBook = appExcel.Workbooks.Add
appExcel.Visible = True
'Active wsheet1
wSheet1 = wBook.Worksheets(1)
wSheet1.Activate()
Dim rngSource As OXL.Range = Nothing
'---------copie valeurs en "colonne"----------
Dim h As Integer = 0
For l As Integer = 0 To DataArray.GetUpperBound(0)
h = h + 1
rngSource = wSheet1.Cells(h, 1)
rngSource.Value = DataArray(l, 0)
h = h + 1
rngSource = wSheet1.Cells(h, 1)
rngSource.Value = DataArray(l, 1)
Next
'
' recupere totalite du rngSource
rngSource = wSheet1.Range(wSheet1.Cells(1, 1), wSheet1.Cells(h, 1))
'---------Les rngDest seront dans wSheet2----------
wSheet2 = wBook.Worksheets(2)
Dim rngDest As OXL.Range = Nothing
'
' copie "plages de 60 elements"
' dans worksheet2 partant de ligne 1 .
'
Dim espacePlage As Integer = 1
Dim startPlage As OXL.Range = Nothing
Dim endPlage As OXL.Range = Nothing
Dim rngTemp As OXL.Range = Nothing 'un range worker
'
' parcourt rngFinal step 60
'
For m As Integer = 1 To rngSource.Rows.Count Step 60
startPlage = rngSource.Item(m, 1)
endPlage = rngSource.Item(m + 60, 1)
rngTemp = wSheet1.Range(startPlage.Address & ":" & endPlage.Address)
'
'sette rngFinal dans wSheet2
'
rngDest = wSheet2.Cells(1, espacePlage)
'copie rngTemp vers rngFinal
'
rngTemp.Copy(rngDest)
'mise en forme de chaque plage
' cette ligne de code suffit à tout :format speciaux d'excel....
' rngFinal.EntireColumn.AutoFormat(OXL.XlRangeAutoFormat.xlRangeAutoFormatColor2)
rngDest.EntireColumn.AutoFit()
rngDest.EntireColumn.ColumnWidth = 25
rngDest.EntireColumn.VerticalAlignment = OXL.XlVAlign.xlVAlignCenter
rngDest.EntireColumn.HorizontalAlignment = OXL.XlHAlign.xlHAlignCenter
rngDest.EntireColumn.Interior.Color = ColorTranslator.ToOle(Color.BlanchedAlmond)
rngDest.EntireColumn.Font.Name = "times new roman"
rngDest.EntireColumn.Font.Size = 16
rngDest.EntireColumn.Font.Bold = True
rngDest.EntireColumn.Font.Color = ColorTranslator.ToWin32(Color.CornflowerBlue)
'
'espace visuel entre plage de 2
'
espacePlage = espacePlage + 5
Next
'Save the workbook and quit Excel.
'
wBook.SaveAs(appChemin & monFichier)
'
Catch ex As System.Runtime.InteropServices.COMException
MessageBox.Show(ex.Source & " " & ex.Message & " " & Hex(ex.ErrorCode))
Finally
releaseObject(appExcel)
releaseObject(wBook)
releaseObject(wSheet1)
End Try
End Sub
' Renvoi les derniers 16 bits de HRESULT = Err code.
' ces 16 bits contiennent code d'error Com d'Excel .
Function GetErrCode(ByVal hresult As Integer) As Integer
Return hresult And &HFFFF
End Function
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
' Force .NET to perform garbage collection.
System.GC.Collect()
End Try
End Sub
End Class |
Partager