MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.
If Combo1.Text = "" Then
With Form29.MSHFlexGrid1
.Col = 11
.ColSel = 0
.ColSel = 3
.ColSel = 4
.ColSel = 6
.ColSel = 7
.ColSel = 8
.ColSel = 9
.ColSel = 10
.Sort = flexSortStringAscending
End With
Set xlObject = New Excel.Application
'This Adds a new woorkbook, you could open the workbook from file also
Set xlWB = xlObject.Workbooks.Add
Clipboard.Clear 'Clear the Clipboard
With Form29.MSHFlexGrid1
'Select Full Contents (You could also select partial content)
.Col = 0 'From first column
.Row = 0 'From first Row (header)
.ColSel = .Cols - 1 'Select all columns
.RowSel = .Rows - 1 'Select all rows
Clipboard.SetText .Clip 'Send to Clipboard
End With
With xlObject.ActiveWorkbook.ActiveSheet
xlObject.ActiveWorkbook.ActiveSheet.Range("a1") = Form29.Combo1.Text
xlObject.ActiveWorkbook.ActiveSheet.Range("a1").Font.Bold = True
xlObject.ActiveWorkbook.ActiveSheet.Range("a1").Font.Size = 17
'205-197-191 = gris
xlObject.ActiveWorkbook.ActiveSheet.Range("A6:p6").Interior.Color = RGB(205, 197, 191)
xlObject.ActiveWorkbook.ActiveSheet.Range("a3") = "Date od this report:"
xlObject.ActiveWorkbook.ActiveSheet.Range("a3").Font.Bold = True
xlObject.ActiveWorkbook.ActiveSheet.Range("B3") = Format(Date, "mmm dd, yyyy")
xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Font.Bold = True
'.BorderAround Weight:=xlThin
xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").ColumnWidth = 20
xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").NumberFormat = "@"
xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").ColumnWidth = 13
xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").NumberFormat = "@"
xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 44
xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").ColumnWidth = 13
xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 26
xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 44
xlObject.ActiveWorkbook.ActiveSheet.Columns("E:E").ColumnWidth = 13
xlObject.ActiveWorkbook.ActiveSheet.Columns("E:E").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("F:F").ColumnWidth = 10
xlObject.ActiveWorkbook.ActiveSheet.Columns("F:F").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("G:G").ColumnWidth = 15
xlObject.ActiveWorkbook.ActiveSheet.Columns("G:G").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("H:H").ColumnWidth = 13
xlObject.ActiveWorkbook.ActiveSheet.Columns("H:H").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("I:I").ColumnWidth = 17
xlObject.ActiveWorkbook.ActiveSheet.Columns("I:I").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").ColumnWidth = 10
xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").ColumnWidth = 10
xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").ColumnWidth = 22
xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").ColumnWidth = 40
xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").ColumnWidth = 20
xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").ColumnWidth = 24
xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Columns("P:P").ColumnWidth = 0
xlObject.ActiveWorkbook.ActiveSheet.Columns("P:P").HorizontalAlignment = xlLeft
xlObject.ActiveWorkbook.ActiveSheet.Range("a3") = "Date od this report:"
xlObject.ActiveWorkbook.ActiveSheet.Range("a3").Font.Bold = True
xlObject.ActiveWorkbook.ActiveSheet.Range("B3") = Format(Date, "mmm dd, yyyy")
xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Font.Bold = True
.Range("A6").Select 'Select Cell A1 (will paste from here, to different cells)
.Paste 'Paste clipboard content
xlObject.ActiveWorkbook.ActiveSheet.Range("C7").Select
xlObject.ActiveWindow.FreezePanes = True
xlObject.ActiveWorkbook.ActiveSheet.Name = xlObject.ActiveWorkbook.ActiveSheet.Range("A1").Text & " " & xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Text
xlObject.ActiveWorkbook.ActiveSheet.Range("A6").Select
End With
'MsgBox "Fichier Excel complÃ©tÃ©"
' This makes Excel visible
xlObject.Visible = True
End If
Unload Me
xlWs.Cells(2, 1).CopyFromRecordset rst
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant
Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
' Set the string to the path of your Northwind database
strDB = "C:\Documents and Settings\daniel\Desktop\Text Xdock.xlsx"
' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Feuil1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
' Check version of Excel
If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets
Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel
' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel
' Determine number of records
recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field
' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If
' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
' Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
' Release Excel references
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant
Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
' Set the string to the path of your Northwind database
strDB = "C:\Documents and Settings\jpoitra\Desktop\Text Xdock.xlsx"
' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Feuil1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
' Check version of Excel
If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
' Copy the recordset to the worksheet, starting in cell A2
Dim rowNumber As Integer
Dim DataIdx As Integer
rowNumber = 7
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1).Text = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2).Text = .TextMatrix(DataIdx, 1)
Next
End With
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets
Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel
' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel
' Determine number of records
recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field
' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If
' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
' Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
' Release Excel references
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant
Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
' Set the string to the path of your Northwind database
strDB = "C:\Documents and Settings\jpoitra\Desktop\Text Xdock.xlsx"
' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Feuil1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
' Check version of Excel
If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
' Copy the recordset to the worksheet, starting in cell A2
Dim rowNumber As Integer
Dim DataIdx As Integer
rowNumber = 7
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13)
xlWs.Cells(rowNumber, 15) = .TextMatrix(DataIdx, 14)
Next
End With
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets
Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel
' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel
' Determine number of records
recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field
' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If
' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
' Close ADO objects
On Error Resume Next
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
' Release Excel references
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Export-result.xlsx
dim sKey as string
sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
dim newKey as string
newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
if newKey <> sKey then
rowNumber = rowNumber + 2
newKey = sKey
end if
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
Next
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13)
xlWs.Cells(rowNumber, 15) = .TextMatrix(DataIdx, 14)
Next
End With
dim sKey as string
sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
dim newKey as string
newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
if newKey <> sKey then
rowNumber = rowNumber + 2
newKey = sKey
end if
' move data from column to excel
rowNumber = rowNumber + 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13
Next
dim sKey as string
sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
dim newKey as string
newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
if newKey <> sKey then
rowNumber = rowNumber + 2
newKey = sKey
end if
' move data from column to excel
rowNumber = rowNumber + 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13
Dim xlObject As Excel.Application
Dim xlWb As Excel.Workbook
Dim NoOfRows As Long
Dim NoOfColumns As Long
Dim i As Single
Dim j As Single
Dim Frmula As String
Dim C1 As String
Dim C2 As String
Dim C3 As String
Dim C4 As String
On Error GoTo MyErrHandler
With CommonDialog1
.CancelError = True
.Filter = "Microsoft Excel files (xlam, xlsx, xltm, xlt, xlsm, xltx, xls, txt, csv)"
.InitDir = "C:\Documents and Settings\all users\Desktop"
.ShowOpen
If Not .FileName = "" Then
Set xlObject = New Excel.Application
Set xlWb = xlObject.Workbooks.Open(.FileName)
FetchNoRowCol xlObject.ActiveWorkbook.ActiveSheet, NoOfRows, NoOfColumns
C1 = 7 - (NoOfColumns + 1)
C2 = 6 - (NoOfColumns + 1)
C3 = 4 - (NoOfColumns + 1)
C4 = 0 - (NoOfColumns + 1)
Frmula = "=IF(RC[" & C1 & "]=R[-1]C[" & C1 & "],IF(RC[" & C2 & "]=R[-1]C[" & C2 & "],IF(RC[" & C3 & "]=R[-1]C[" & C3 & "],IF(RC[" & C4 & "]=R[-1]C[" & C4 & "],1,0),0),0),0)"
For i = 2 To NoOfRows
xlWb.Worksheets(1).Cells(i, NoOfColumns + 1).FormulaR1C1 = Frmula
Next i
Clipboard.Clear
xlObject.Cells.Copy ' Copy all cells in active worksheet.
With MSHFlexGrid1
.Redraw = False 'Dont draw until the end, so we avoid that flash
.Rows = NoOfRows
.Cols = NoOfColumns + 1
.Row = 0 'Paste from first cell
.Col = 0
.RowSel = .Rows - 1 'Select maximum allowed (your selection shouldnt be greater than this)
.ColSel = .Cols - 1
.Clip = Replace(Clipboard.GetText, vbNewLine, vbCr) 'Replace carriage return with the correct one
.Col = 1 'Just to remove that blue selection from Flexgrid
.Col = NoOfColumns
.ColWidth(NoOfColumns) = 0
For i = 2 To NoOfRows - 1
.Col = NoOfColumns
.Row = i
If .Text = 1 Then
For j = 1 To NoOfColumns
.Col = j
.Row = i
.CellBackColor = vb3DLight
Next
End If
Next
.Redraw = True 'Now draw
End With
xlObject.DisplayAlerts = False 'To avoid "Save woorkbook" messagebox
xlWb.Close
xlObject.Application.Quit
Set xlWb = Nothing
Set xlObject = Nothing
End If
End With
'Auto column fit
Dim r As Long
Dim C As Long
Dim cell_wid As Single
Dim col_wid As Single
For C = 0 To MSHFlexGrid1.Cols - 1
col_wid = 0
For r = 0 To MSHFlexGrid1.Rows - 1
cell_wid = TextWidth(MSHFlexGrid1.TextMatrix(r, C))
If col_wid < cell_wid Then col_wid = cell_wid
Next r
MSHFlexGrid1.ColWidth(C) = col_wid + 120
Next C
'MSHFlexGrid1.ColAlignment(2) = flexAlignLeftCenter
Dim z As Long, txt As String, total As Long
For z = 1 To MSHFlexGrid1.Rows - 1
If Len(MSHFlexGrid1.TextMatrix(z, 3)) Then total = total + 1
Next z
lblTotalrecord = CStr(total)
'Command3.Enabled = False
If lblTotalrecord > "" Then
Command3.Enabled = True
Else
Command3.Enabled = False
End If
'Command1.Enabled = False
If lblTotalrecord > "" And lblTotalrecord1 > "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
MSHFlexGrid1.CellAlignment = 0
Dim k As Long
For k = 1 To MSHFlexGrid1.Rows - 1
If MSHFlexGrid1.TextMatrix(k, 1) <> "" Then
MSHFlexGrid1.TextMatrix(k, 5) = MSHFlexGrid1.TextMatrix(k, 0) & MSHFlexGrid1.TextMatrix(k, 1) & MSHFlexGrid1.TextMatrix(k, 6)
End If
Next k
Exit Sub
MyErrHandler:
Err.Clear
Sub AddTotal1(sh As Worksheet)
Dim Time As String
Dim Amt As Double
Dim Amt1 As Double
Dim Amt2 As Double
Dim Amt3 As Double
Dim Amt4 As Double
Dim Amt5 As Double
Dim Amt6 As Double
Dim Amt7 As Double
Dim Amt8 As Double
Dim Counter As String
On Error Resume Next
Counter = 7
With sh
sh.Activate
Do
Time = .Cells(Counter, 10).Value
Do
Amt = Amt + .Cells(Counter, 1)
Amt1 = Amt1 + .Cells(Counter, 4)
Amt2 = Amt1 + .Cells(Counter, 5)
Amt3 = Amt1 + .Cells(Counter, 6)
Amt4 = Amt1 + .Cells(Counter, 7)
Amt5 = Amt1 + .Cells(Counter, 8)
Amt6 = Amt1 + .Cells(Counter, 9)
Amt7 = Amt1 + .Cells(Counter, 10)
Amt8 = Amt1 + .Cells(Counter, 11)
Counter = Counter + 1
Loop Until Time <> .Cells(Counter, 10)
'Insert Total
.Cells(Counter, 1).EntireRow.Insert
.Cells(Counter, 2) = "Total"
.Cells(Counter, 2).Font.Bold = True
.Cells(Counter, 3) = Amt
.Cells(Counter, 3).Font.Bold = True
.Cells(RowNum, 4) = Amt1
.Cells(Counter, 4).Font.Bold = True
.Cells(Counter + 1, 1).EntireRow.Insert
Counter = Counter + 2
Amt = 0
Amt1 = 0
Amt2 = 0
Amt3 = 0
Amt4 = 0
Amt5 = 0
Amt6 = 0
Amt7 = 0
Amt8 = 0
Loop Until .Cells(Counter, 10) = ""
End With
End Sub
AddTotal1 xlObject.ActiveWorkbook.ActiveSheet
dim sKey as string
sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 13)
With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
dim newKey as string
newKey = TextMatrix(DataIdx, 13)
if newKey <> sKey then
rowNumber = rowNumber + 2
newKey = sKey
end if
' move data from column to excel
rowNumber = rowNumber + 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13)
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Macro which automatically sends attachment to Outlook | 14 | 78 | |
JSON Response and request in VB6 application | 11 | 589 | |
VBA - Excel, Hide/unhide range of rows on sheet with listbox selection | 9 | 63 | |
how to loop through and process two columns in excel | 8 | 25 |
Join the community of 500,000 technology professionals and ask your questions.