Modifications

Aller à : navigation, rechercher

Aide:Transformer un tableau Excel en tableau WikiGenWeb

354 octets ajoutés, 24 février 2011 à 20:47
m
Création d'une macro
<pre>
Sub xls_to_wgw()
On Error Resume Next
titre = "Excel to WikiGenWeb"
ncols = Application.InputBox("Nombre de colonnes à partir de A ?", titre)
nrows = Application.InputBox("Nombre de lignes à partir de 1 ?", titre)
Range("A1:" & Chr(ncols + 64) & "1").Select
For Each cell In Selection
If cell.Value = "" Then
If MsgBox("Au moins 1 colonne de la ligne 1 n'est pas renseignée." & vbCrLf & "Continuer ?", vbYesNo, titre) = vbNo Then
Exit Sub
End If
End If
Next cell
Range("A1:A" & nrows).Select
For Each cell In Selection
If cell.Value = "" Then
If MsgBox("Au moins 1 ligne de la colonne A n'est pas renseignée." & vbCrLf & "Continuer ?", vbYesNo, titre) = vbNo Then
Exit Sub
End If
End If
Next cell
On Error Resume Next titre = "Excel to WikiGenWeb" ncols = Application.InputBox("Nombre de colonnes à partir de A ?", titre) nrows = Application.InputBox("Nombre de lignes à partir de 1 ?", titre) Range("A1:" & Chr(ncols + 64) & "1").Select For Each cell In Selection If cell.Value = "" Then If MsgBox("Au moins 1 colonne de la ligne 1 n'est pas renseignée." & vbCrLf & "Continuer ?", vbYesNo, titre) = vbNo Then Exit Sub End If End If Next cell Range("A1:A" & nrows).Select For Each cell In Selection If cell.Value = "" Then If MsgBox("Au moins 1 ligne de la colonne A n'est pas renseignée." & vbCrLf & "Continuer ?", vbYesNo, titre) = vbNo Then Exit Sub End If End If Next cell nom = ActiveSheet.Name Sheets("xls_to_wgw").Select ActiveWindow.SelectedSheets.Delete Sheets(nom).Select ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = "xls_to_wgw" Sheets("xls_to_wgw").Select Cells.Select Application.CutCopyMode = False Selection.ClearContents Sheets(nom).Select Range("A1:" & Chr(ncols + 64) & nrows).Select Selection.Copy Sheets("xls_to_wgw").Select Range("A1").Select ActiveSheet.Paste Columns("A:A").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B2").Select Columns("B:B").ColumnWidth = 120 Range("B2").Select For rwIndex = 2 To nrows + 1 texte = "<!-- (L " & rwIndex - 1 & ") -->|-" For colIndex = 3 To ncols + 2 texte = texte & "|" & Cells(rwIndex, colIndex) & "|" Next colIndex texte = Left(texte, Len(texte) - 1) Cells(rwIndex, 2) = texte Next rwIndex Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile("c:\excel-to-mediawiki.txt", True) a.WriteLine ("{| class=wikitable") Range("B2:B" & nrows + 1).Select For Each cell In Selection texte = Replace(cell.Value, "|-", "|-" & vbCrLf) a.WriteLine (texte) Next cell a.WriteLine ("|}") a.Close Range("B2").Select Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(nrows - 1, 0)).Select MsgBox "La feuille Excel " & Sheets(nom).Name & " a été transformée en fichier WikiGenWeb sour le nom c:\excel-to-mediawiki.txt que vous devez copier dans votre article." & vbCrLf _ & ncols & " colonnes." & vbCrLf & nrows & " lignes."
End Sub
</pre>
 
 
'''Ne pas fermer la page des macros et cocher une référence supplémentaire obligatoire.'''
*Cliquer sur menu : outils et ensuite sur références
*Cocher la case Microsoft Scripting Runtime dans la liste affichée
*Cliquer sur OK
*Enregistrer
*Fermer la page des macros
==Travaux de mise en forme sous éditeur==
Wgw
5 307
modifications

Menu de navigation