====== generation de tableau depuis excel ======
^ ^txt1qjmlkqsjmflkjqlmk^qsfsqjklmùfkjs^fsdmklhmfKLJHQMFK^
|ligne 1|qd|**d**| |
| ligne 2| | |d|
|**ligne 3**| ggghr | dfgg|drrdesghj|
===== la macro excel =====
à copier dans module 1 et créer un onglet "wikioutput"
Sub SelectionToWiki()
' you need at least Excel 2000 and add a reference to the MS Forms Library: Tools ? References ?
' Make sure Microsoft Forms 2.0 Object Library is checked
' Macro to convert/export the selected cells into a DokuWiki table
' Tested with DokuWiki 2007-06-26
' Limitations:
' won't format individual characters within a cell
Dim currentSelection As Range, thisCell As Range
Dim wikiText As String, thisCellText As String, outtabName As String
Dim rows As Integer, cols As Integer, thisRow As Integer, thisCol As Integer
Dim inMerge As Boolean
Dim sh As Worksheet
'Dim oData As DataObject
' you need at least Excel 2000 and add a reference to the MS Forms Library: Tools ? References ?
' Make sure Microsoft Forms 2.0 Object Library is checked
'Set oData = New DataObject
Set currentSelection = ActiveWindow.RangeSelection
rows = currentSelection.rows.Count
cols = currentSelection.Columns.Count
wikiText = ""
For thisRow = 1 To rows
inMerge = False
For thisCol = 1 To cols
Set thisCell = currentSelection.Cells(thisRow, thisCol)
If Not thisCell.MergeCells Then
inMerge = False
End If
'cell coloring
If thisCell.Interior.ColorIndex = xlNone Then
wikiText = wikiText & "|"
Else
wikiText = wikiText & "^"
End If
'value
thisCellText = thisCell.Text
'if it's an empty cell then make it a space (to avoid merging cells)
If Not inMerge And thisCellText = "" Then thisCellText = " "
If Not inMerge Then
'don't apply formatting and alignment for cells within a merged area (only the first cell gets that)
'formatting
With thisCell.Font
If .Bold = True Then thisCellText = "**" & thisCellText & "**"
If .Italic = True Then thisCellText = "//" & thisCellText & "//"
If .Underline <> xlUnderlineStyleNone Then thisCellText = "__" & thisCellText & "__"
End With
'alignment
Select Case thisCell.HorizontalAlignment
Case xlLeft
thisCellText = thisCellText & " "
Case xlRight
thisCellText = " " & thisCellText
Case xlCenter
thisCellText = " " & thisCellText & " "
End Select
End If
'check for merged cells
If thisCell.MergeCells Then
inMerge = True
End If
'add this cell to wiki output string
wikiText = wikiText & thisCellText
Next thisCol
'end this row
If thisRow = 1 Then
'heading row
wikiText = wikiText & "^" + Chr(13)
Else
wikiText = wikiText & "|" + Chr(13)
End If
Next thisRow
outtabName = "wikioutput"
Sheets(outtabName).Select
'If WorksheetExits(outtabName) Then
' Sheets(outtabName).Select
'Else
' create output worksheet
' Set sh = Worksheets.Add(ActiveWorkbook.Sheets(1), , , xlWorksheet) 'always add Worksheets(outtabName) at first place
' sh.Name = outtabName 'was Worksheets(1).name = outtabName
' sh.Select
' End If
Range("A1").Select
ActiveCell.FormulaR1C1 = wikiText
'now copy to clipboard
'oData.SetText (wikiText)
'oData.PutInClipboard
'MsgBox "Selected cells were copied into clipboard", vbInformation
End Sub
===== Add this macro to Excel menu =====
If you want add this macro to Excel **Tools** menu. Create a new XLA file with the sub **SelectionToWiki** in VBA module and add this macro to **ThisWorkBook** module.
Private Sub Workbook_Open()
Const strExceltoWiki As String = "Copy Selection to Wiki"
Dim myButton As CommandBarButton
Dim Wb As Workbook
Dim I As Integer
'Check in current Tools menu if item already exist
For I = 1 To Application.CommandBars("Tools").Controls.Count
If Application.CommandBars("Tools").Controls(I).Caption = strExceltoWiki Then
Exit Sub
End If
Next I
Set myButton = Application.CommandBars("Tools").Controls.Add(Type:=msoControlButton, temporary:=True)
myButton.Caption = strExceltoWiki
myButton.Style = msoButtonCaption
myButton.BeginGroup = True
myButton.OnAction = "SelectionToWiki"
End Sub