Wikiup Diskussion:Technik/Text/Basic/EXCEL-Tabellenumwandlung/en

Sehr Gut ! Danke shoen.

Very good work. Thank you.

Dennis Spring [Email Adress removed]

--145.24.23.186 15:01, 2. Jun. 2008 (CEST)

Fehler

I get error on this code:

  Set orange = sh.Range(Cells(1, 1), Cells(65353, 1))
   orange.Select
   '( Rows(65534), Columns(1))

any idea???

What's the errormessage? How should I reproduce that? please sign your postings. ~regards, ollio 23:52, 2. Jun. 2008 (CEST)

Ok, I will try to give you impresion with screen shots, oeps, can't upload screenshots to this wiki....you find the screen shots here, --Arthur56 14:09, 4. Jun. 2008 (CEST)

Hi arthur, your screenshots are not very specific and I can't understand a dutch error message. Please give an the english or german error message of microsoft or at least translate the message into english yourself. Then please give any usefull information needed to reproduce the error. You don't need to give screenshots, just describe it here as precisely you can. What version of EXCEL you use? What operating System are you working with (OS or MAC, what version)? If you can't make me reproduce the error by giving precise information, your chances to get being helped are quite low. Maybe your handling of the macro is just not correct? --ollio 20:27, 5. Jun. 2008 (CEST)

Functions myhex / hexdigit

I've just come across this marvellous program; I think it will be very useful to me when creating tables in Wikipedia.

Reading the code, the first thing I noticed is the use of a constant in the statement

Set orange = sh.Range(Cells(1, 1), Cells(65353, 1))

Wouldn't the statement

 Set orange = Worksheets("Sheet1").Range("A:A")

do the same thing without having to use the constant (which does not apply to Excel versions after 11 (2003) — that constant can also be replaced with sh.Rows.Count .

Thinking further along these lines, it occurred to me that the code could be slighty simplified by doing away with the concept of an "output range" and address the output sheet directly instead. For this, we need to change some declarations:

 'Dim orange As Range 'outputrange
 Dim orange As Worksheet 'outputrange

and drop this one:

 'Dim sh As Worksheet

and then change

 '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
 'Set orange = sh.Range(Cells(1, 1), Cells(65353, 1))
 'orange.Select

to

 Set orange = Worksheets.Add(ActiveWorkbook.Sheets(1), , , xlWorksheet) 'always add  Worksheets(outtabName) at first place
 orange.Name = outtabName 'was Worksheets(1).name = outtabName

Next, I noticed the functions hexdigit() and myhex(); the comments in myhex() suggest it converts 16-bit numbers, but it seems to me it converts 24-bit numbers (which should probably be restricted to 16^6-1). But I couldn't work out why the program didn't use the built-in function Hex() instead, until I realised that the resulting values are used for HTML color codes where leading zeroes are required. I suggest the functions hexdigit() can be removed and myhex() can be replaced by this:

 Function myhex(num as Long) as String
 myhex=PadLeft(Hex(num),6,"0")
 End Function

and the addition of

 Function PadLeft(strString As String, lngWidth As Long, strChar As String) As String
 PadLeft = String(Application.WorksheetFunction.Max(lngWidth - Len(strString), 0), strChar) & strString
 End Function

The above are just cosmetic suggestions. What I want to tackle next is to omit hidden rows and columns in the conversion process.

After that, I would like to output cell comments as: <span style="display:none">cell comment</span>, similar to what en:Template:Hs does. This is a very useful feature to add hidden sort keys to tables whose normal content doesn't lend itself to proper sorting. For an example, see the table code (and functionality) at en:Köchel catalogue.

Again, thank you very much for this program. Alled Gute, -- Michael Bednarek 06:27, 30. Sep. 2008 (CEST)

Skip hidden rows & columns

I have now added checks so that hidden rows and columns are skipped. The main Sub now looks like this:

Public Sub Format_as_wikitable() ' ===== The main program =====
' implicit parameter: selected range
' writes the output into table: wikioutput
' caution if this table exists it is deleted !!!

Dim FirstLineCellWritten As Boolean ' Did we write the first line?

If Not TypeOf Selection Is Range Then
    MsgBox "Error: You must select a cellrange, to convert to a wiki-table, but you " _
    & vbCrLf & " have selected a " & TypeName(Selection)
Else
    Set selrange = Selection
    wasUnderlined = False
    iLineMax = selrange.Rows.Count
    iColumnMax = selrange.Columns.Count
    outtabName = "wikioutput"
    If WorksheetExits(outtabName) Then
       Worksheets(outtabName).Delete
    End If
    oline = 0
    ' 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
    'Set orange = sh.Range(Cells(1, 1), Cells(65353, 1))
    'orange.Select
    
    Set orange = Worksheets.Add(ActiveWorkbook.Sheets(1), , , xlWorksheet) 'always add  Worksheets(outtabName) at first place
    orange.Name = outtabName 'was Worksheets(1).name = outtabName
    '( Rows(65534), Columns(1))
    write_tablehead
    For iline = 1 To iLineMax
       If Not selrange.Rows(iline).Hidden Then  ' Skip hidden rows
         write_lineheader
         FirstLineCellWritten = False
         For icolumn = 1 To iColumnMax
           If Not selrange.Columns(icolumn).Hidden Then ' Skip hidden columns
             If Not FirstLineCellWritten Then ' was: iline = 1 Then
               writefirstlinecell (icolumn)
               FirstLineCellWritten = True ' Remember
             Else
               writecell (icolumn)
             End If
           End If ' Not selrange.Columns(iline, icolumn).Hidden
         Next icolumn
         write_linetrailer
      End If ' Not selrange.Columns(iline, 1).Hidden
    Next iline
    write_tabletail
End If 'Not TypeOf selrange Is Range Then
orange.Columns("A:A").AutoFit ' Cosmetics
End Sub

I also noticed that the columnwidth for merged cells in the first row is not properly set. In the function Function formatstring_for_a_cellcontent() change this

'prop = "width=@" & Round(.Width, 0) & "@" '<V17  ' This will set the width for merged columns wrong

to this

prop = "width=@" & Round(.MergeArea.Width, 0) & "@"   ' This works even if the cell is not in a merge area

Alles Gute, -- Michael Bednarek 11:11, 30. Sep. 2008 (CEST)

Adapting for Mac

Great Macro. I've just had to adapt it for my Mac running Excel X or Excel 2004. The Round and Replace functions do not work in Excel for the Mac so:

1. I added in the BRound function (from http://support.microsoft.com/default.aspx?scid=kb;en-us;196652) and changed:

      prop = "width=@" & Round(.Width, 0) & "@" '<V17

to

      prop = "width=@" & BRound(.Width, 1) & "@" '<V17

and

      prop = "height=@" & Round(.Height, 0) & "@" '<V17

to

      prop = "height=@" & BRound(.Height, 1) & "@" '<V17

2. Replace can be substituted by changing:

 process_cellcontent = Replace(cellcontent, vbLf, "<BR>")

to

 process_cellcontent = WorksheetFunction.Substitute(cellcontent, vbLf, "<BR>")

Since I see the "WorksheetFunction.Substitute" function 9 lines earlier, I suggest replacing the Replace function in the macro entirely.

Thanks for this useful function - Lensyl Urbano

No Borders being copied across

I've tried using the Macro, but not been able to get it to copy the Border format across, any reason for this?

See below for example:

Date	Issue	Description	Time to Resolve	Business Impact	Improvements

Ah, it works here, but not, apparently on wikimedia 1.13.3....

Argon0

Don't prompt user for delete of wikioutput sheet

If it already exists just clear it. In Public Sub Format_as_wikitable():

   Dim sh As Worksheet
   outtabName = "wikioutput"
   If WorksheetExits(outtabName) Then
      Worksheets(outtabName).Range("A:A").Clear
      Set sh = Worksheets(outtabName)
   Else
      sh = Worksheets.Add(ActiveWorkbook.Sheets(1), , , xlWorksheet) 'always add  Worksheets(outtabName) at first place
      sh.Name = outtabName 'was Worksheets(1).name = outtabName
   End If

Errors in use of settings

Based on existing logic:

   If .VerticalAlignment <> xlVAlignCenter And Not lineattribut_Halignment_set Then  ' dont write the default

should be

   If .VerticalAlignment <> xlVAlignCenter And lineattribut_Halignment_set Then

Note also: With the current version's logic the width settings do not work well unless the font size is default (i.e., 10pt)!

Reverse: Wikitable to XLS

How it works? --Markus 00:02, 19. Jul. 2011 (CEST)

save Wiki-table as HTML, copy HTML to Excel, delete needless things, save Excel as XLS. --Markus 02:02, 19. Jul. 2011 (CEST)