Sujet Précédent Sujet Suivant

Passage de msflexgrid a excel

cs_jollyJumper Messages postés 7 Date d'inscription mercredi 17 avril 2002 Statut Membre Dernière intervention 2 mai 2002 - 22 avril 2002 à 09:45
cs_kitian Messages postés 4 Date d'inscription mardi 17 décembre 2002 Statut Membre Dernière intervention 7 décembre 2004 - 7 déc. 2004 à 17:08
comment exporter un msflexgrid vers un classeur excel que l'on veut créer?
en vous remerciant par avance

jumper

3 réponses

Réponse 1 / 3
cs_kitian Messages postés 4 Date d'inscription mardi 17 décembre 2002 Statut Membre Dernière intervention 7 décembre 2004
7 déc. 2004 à 17:08
Public Sub Ecriture_dans_fichier_xls()

Dim objXL As New Excel.Application
Dim wbXL, ExcelSht As New Excel.Workbook
Dim wsXL As New Excel.Worksheet
Dim intRow As Integer ' counter
Dim intCol As Integer ' counter
On Error Resume Next

If Not IsObject(objXL) Then
MsgBox "You need Microsoft Excel to use this function", _
vbExclamation, "Print to Excel"
Exit Sub
End If

' open Excel

Set wbXL = objXL.Workbooks.Add

objXL.DisplayAlerts = False

intSheets = objXL.SheetsInNewWorkbook
'je vire les feuilles par defaut
Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop
With FrmResult.GrdResult 'premier msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet

' name the worksheet
wsXL.Name = "Premiere feuille"
' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.MSFlexGrid1 'deuxieme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Inventory"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
DoEvents
End With
With FrmResult.GrdMaintenance '3eme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Operation,Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.GrdResultOEM
'Wbk = FlexGrid_To_Excel(Wbk, FrmResult.GrdResultOEM, .Rows, .Cols, , "OEM Maintenance")
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "OEM Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
objXL.DisplayAlerts = False
intSheets = objXL.SheetsInNewWorkbook

Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop

objXL.DisplayAlerts = True

objXL.Visible = True
'DoEvents
end Sub
0
Réponse 2 / 3
cs_kitian Messages postés 4 Date d'inscription mardi 17 décembre 2002 Statut Membre Dernière intervention 7 décembre 2004
7 déc. 2004 à 17:08
Public Sub Ecriture_dans_fichier_xls()

Dim objXL As New Excel.Application
Dim wbXL, ExcelSht As New Excel.Workbook
Dim wsXL As New Excel.Worksheet
Dim intRow As Integer ' counter
Dim intCol As Integer ' counter
On Error Resume Next

If Not IsObject(objXL) Then
MsgBox "You need Microsoft Excel to use this function", _
vbExclamation, "Print to Excel"
Exit Sub
End If

' open Excel

Set wbXL = objXL.Workbooks.Add

objXL.DisplayAlerts = False

intSheets = objXL.SheetsInNewWorkbook
'je vire les feuilles par defaut
Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop
With FrmResult.GrdResult 'premier msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet

' name the worksheet
wsXL.Name = "Premiere feuille"
' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.MSFlexGrid1 'deuxieme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Inventory"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
DoEvents
End With
With FrmResult.GrdMaintenance '3eme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Operation,Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.GrdResultOEM
'Wbk = FlexGrid_To_Excel(Wbk, FrmResult.GrdResultOEM, .Rows, .Cols, , "OEM Maintenance")
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "OEM Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
objXL.DisplayAlerts = False
intSheets = objXL.SheetsInNewWorkbook

Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop

objXL.DisplayAlerts = True

objXL.Visible = True
'DoEvents
end Sub
0
Réponse 3 / 3
cs_kitian Messages postés 4 Date d'inscription mardi 17 décembre 2002 Statut Membre Dernière intervention 7 décembre 2004
7 déc. 2004 à 17:08
Public Sub Ecriture_dans_fichier_xls()

Dim objXL As New Excel.Application
Dim wbXL, ExcelSht As New Excel.Workbook
Dim wsXL As New Excel.Worksheet
Dim intRow As Integer ' counter
Dim intCol As Integer ' counter
On Error Resume Next

If Not IsObject(objXL) Then
MsgBox "You need Microsoft Excel to use this function", _
vbExclamation, "Print to Excel"
Exit Sub
End If

' open Excel

Set wbXL = objXL.Workbooks.Add

objXL.DisplayAlerts = False

intSheets = objXL.SheetsInNewWorkbook
'je vire les feuilles par defaut
Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop
With FrmResult.GrdResult 'premier msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet

' name the worksheet
wsXL.Name = "Premiere feuille"
' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.MSFlexGrid1 'deuxieme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Inventory"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
DoEvents
End With
With FrmResult.GrdMaintenance '3eme msflexgrid
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "Operation,Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
With FrmResult.GrdResultOEM
'Wbk = FlexGrid_To_Excel(Wbk, FrmResult.GrdResultOEM, .Rows, .Cols, , "OEM Maintenance")
Set wsXL = wbXL.Worksheets.Add
Set wsXL = objXL.ActiveSheet
' name the worksheet
wsXL.Name = "OEM Maintenance"

' fill worksheet
For intRow = 1 To .Rows
For intCol = 1 To .Cols
wsXL.Cells(intRow, intCol).Value = _
.TextMatrix(intRow - 1, intCol - 1) & " "
Next
Next

' format the look
For intCol = 1 To .Cols
wsXL.Columns(intCol).AutoFit
'wsXL.Columns(intCol).AutoFormat (1)
wsXL.Range("a1", Right(wsXL.Columns(.Cols).AddressLocal, _
1) & .Rows).AutoFormat GridStyle
Next
'DoEvents
End With
objXL.DisplayAlerts = False
intSheets = objXL.SheetsInNewWorkbook

Do While intSheets > -1
wbXL.Worksheets("Sheet" & CStr(intSheets)).Delete
wbXL.Worksheets("Feuil" & CStr(intSheets)).Delete
intSheets = intSheets - 1
Loop

objXL.DisplayAlerts = True

objXL.Visible = True
'DoEvents
end Sub
0

Discussions similaires

EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Organiser un planning annuel pour le plan préventive d'un parc machine sous acce
sassene -
aminwmalih -

1 réponse
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Excel - Coefficients courbe de régression/tendance
looth -
pikafafe -

8 réponses
Affichage du userform dès l'ouverture du fichier excel
payhpayh7 -
aslalaud -

4 réponses
Rejoignez-nous