====== 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