Re : Ouverture en lecture seule: Problème
Merci de ta réponse
hum .... bah je sais pas, j ai pas fait en sorte qu'il souvre en lecture seule, sinon je pense que oui il est deja a moitier ouvert mais c'est un peu ibliger si je veux mettre les données dedans non ?
Voila mon module
______________________________________________________________________________________________
Sub MiseEnForme()
'_________variables_____________
Dim i, j As Long
Dim extension, Champs As String
Dim tablo
'________________________________
With Parametres
If .BoxExtension.Text = ".csv (recommandé)" Then
extension = ".csv"
Else
extension = .BoxExtension.Value
End If
file = .FolderAddress.Text & "\" & .FileName.Text & extension
End With
Open file For Append As #2
' on copie tout le tableau dans la feuille training dans le tableau : "tablo"
tablo = Sheets("training").Range("A1:" & Sheets("training").Cells.SpecialCells(xlCellTypeLastCell).Address)
' ensuite on écrase la premiere ligne de ce tableau avec le titre des colonnes qu'on a choisit
' si ce n'est pas un titre de colonne voulu on écrase le titre précédent avec une valeur NULL
For i = 1 To UBound(tablo, 2)
Select Case Trim(tablo(1, i))
Case "Learner Area", "Learner Sub-Area", "Learner Country", "Learner Company", _
"Type", "Job", "Certification Level", "Release", "Reference", "Title", "Start Date"
tablo(1, i) = Replace(tablo(1, i), " ", "_")
tablo(1, i) = Replace(tablo(1, i), ":", "")
tablo(1, i) = Replace(tablo(1, i), "/", "_")
Case "Classroom Duration (Trainee Days)"
tablo(1, i) = "Classroom_Duration_Days"
Case "E-learning Duration (Hours)"
tablo(1, i) = "Elearning_Duration_Hours"
Case "Internal/External"
tablo(1, i) = "Int_Ext"
Case Else
tablo(1, i) = ""
End Select
Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(file)
Set ws = wb.Worksheets(1)
Dim DateArray() As String
' on copie tout le tableau : "tablo" dans le nouveau fichier
Workbooks(Parametres.FileName.Text & extension).Sheets(Parametres.FileName.Text).Range("A1:" & Workbooks("Trainingcheck_update2_macro.xlsm").Sheets("training").Cells.SpecialCells(xlCellTypeLastCell).Address) = tablo
' on supprime toutes les colonnes qui n'ont pas de titre à la premiere ligne (ou leur titre a la valeur NULL)
Workbooks(Parametres.FileName.Text & extension).Sheets(Parametres.FileName.Text).Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
tablo = Sheets(Parametres.FileName.Text).Range("A1:" & Sheets(Parametres.FileName.Text).Cells.SpecialCells(xlCellTypeLastCell).Address)
' Lorsqu'une copie des colonnes est effectuée du fichier de base au fichier créé par l utilisateur, le format de la date change tout seul et passe de yyyy-mm-dd à dd/mm/yyyy
' C'est pour cela qu'on rechange le format pour le remettre comme à l'origine:
For i = 1 To UBound(tablo, 2)
If tablo(1, i) = "Start_Date" Then
For j = 2 To UBound(tablo, 1)
DateArray() = Split(tablo(j, i), "/")
Workbooks(Parametres.FileName.Text & extension).Sheets(Parametres.FileName.Text).Range(Chr(64 + i) & j).NumberFormat = "yyyy-mm-dd"
Workbooks(Parametres.FileName.Text & extension).Sheets(Parametres.FileName.Text).Range(Chr(64 + i) & j).Value = DateArray(2) & "-" & DateArray(1) & "-" & DateArray(0)
Next
End If
Next
' permet à l'utilisateur de ne pas afficher le fichier et donc de le fermer et sauvegarder
' If Parametres.AffTexte.Value = False Then
' ActiveWorkbook.SaveAs FileName:=file, FileFormat:=xlCSV
' ActiveWorkbook.Close
'End If
Unload Parametres
Close #2
End Sub
______________________________________________________________________________________________
le probleme viendrait de la ligne que j'ai mis en rouge d'apres toi ? je vois pas comment faire autrement ... je suis pas un As en VBA ^^