Outils pour utilisateurs

Outils du site


wiki:export_from_excel

generation de tableau depuis excel

txt1qjmlkqsjmflkjqlmkqsfsqjklmùfkjsfsdmklhmfKLJHQMFK
ligne 1qdd
ligne 2 d
ligne 3 ggghr dfggdrrdesghj

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
wiki/export_from_excel.txt · Dernière modification: 07/2011 par 212.77.163.106