Excelにはファイル(ワークブック)をXMLでエクスポートする機能があります。
セルの大きさやフォントサイズなども再現されるので巨大なファイルになります。
逆にセルの値や計算式のみを再現するためのXMLはどんなファイルになるか、調べてみました。Excel2007で確認しました。
ワークブック
次のようなシートが2枚あるワークブックを作ります。
「売上」シート
D列には「=B2*C2」のような計算式が含まれます。
A | B | C | D | |
---|---|---|---|---|
1 | 商品 | 単価 | 個数 | 金額 |
2 | りんご | 200 | 10 | 2000 |
3 | みかん | 100 | 30 | 3000 |
「支店」シート
A | B | C | |
---|---|---|---|
1 | 番号 | 支店名 | 所在地 |
2 | 5 | 埼玉支社 | さいたま市 |
3 | 6 | 千葉支社 | 千葉市 |
4 | 7 | 神奈川支社 | 横浜市 |
XMLファイル
このワークブックをXMLで表わすと次のようになります。
値と計算式だけがセットされています。
Workbookの中にWorksheetとTableがあります。
さらにRowが行を表し、Cellがセルを表します。
文字列はString、数値はNumberです。数式はR1C1形式です。
<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet">
<Worksheet ss:Name="売上">
<Table>
<Row>
<Cell><Data ss:Type="String">商品</Data></Cell>
<Cell><Data ss:Type="String">単価</Data></Cell>
<Cell><Data ss:Type="String">個数</Data></Cell>
<Cell><Data ss:Type="String">金額</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="String">りんご</Data></Cell>
<Cell><Data ss:Type="Number">200</Data></Cell>
<Cell><Data ss:Type="Number">10</Data></Cell>
<Cell ss:Formula="=RC[-2]*RC[-1]"></Cell>
</Row>
<Row>
<Cell><Data ss:Type="String">みかん</Data></Cell>
<Cell><Data ss:Type="Number">100</Data></Cell>
<Cell><Data ss:Type="Number">30</Data></Cell>
<Cell ss:Formula="=RC[-2]*RC[-1]"></Cell>
</Row>
</Table>
</Worksheet>
<Worksheet ss:Name="支店">
<Table>
<Row>
<Cell><Data ss:Type="String">番号</Data></Cell>
<Cell><Data ss:Type="String">支店名</Data></Cell>
<Cell><Data ss:Type="String">所在地</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">1</Data></Cell>
<Cell><Data ss:Type="String">埼玉支社</Data></Cell>
<Cell><Data ss:Type="String">さいたま市</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">2</Data></Cell>
<Cell><Data ss:Type="String">千葉支社</Data></Cell>
<Cell><Data ss:Type="String">千葉市</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">3</Data></Cell>
<Cell><Data ss:Type="String">神奈川支社</Data></Cell>
<Cell><Data ss:Type="String">横浜市</Data></Cell>
</Row>
</Table>
</Worksheet>
</Workbook>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet">
<Worksheet ss:Name="売上">
<Table>
<Row>
<Cell><Data ss:Type="String">商品</Data></Cell>
<Cell><Data ss:Type="String">単価</Data></Cell>
<Cell><Data ss:Type="String">個数</Data></Cell>
<Cell><Data ss:Type="String">金額</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="String">りんご</Data></Cell>
<Cell><Data ss:Type="Number">200</Data></Cell>
<Cell><Data ss:Type="Number">10</Data></Cell>
<Cell ss:Formula="=RC[-2]*RC[-1]"></Cell>
</Row>
<Row>
<Cell><Data ss:Type="String">みかん</Data></Cell>
<Cell><Data ss:Type="Number">100</Data></Cell>
<Cell><Data ss:Type="Number">30</Data></Cell>
<Cell ss:Formula="=RC[-2]*RC[-1]"></Cell>
</Row>
</Table>
</Worksheet>
<Worksheet ss:Name="支店">
<Table>
<Row>
<Cell><Data ss:Type="String">番号</Data></Cell>
<Cell><Data ss:Type="String">支店名</Data></Cell>
<Cell><Data ss:Type="String">所在地</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">1</Data></Cell>
<Cell><Data ss:Type="String">埼玉支社</Data></Cell>
<Cell><Data ss:Type="String">さいたま市</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">2</Data></Cell>
<Cell><Data ss:Type="String">千葉支社</Data></Cell>
<Cell><Data ss:Type="String">千葉市</Data></Cell>
</Row>
<Row>
<Cell><Data ss:Type="Number">3</Data></Cell>
<Cell><Data ss:Type="String">神奈川支社</Data></Cell>
<Cell><Data ss:Type="String">横浜市</Data></Cell>
</Row>
</Table>
</Worksheet>
</Workbook>
マクロ
Excelのワークブックを上のシンプルなXMLに書き出すマクロを作ってみました。
Excelファイルを開いた状態でマクロ「ワークブックをXMLで書き出す」を実行するとデスクトップに「myfile.xml」というファイルが書き出されます。
複数シートに対応しています。各シートの100行100列までを書き出します。
なお、使い道は分かりません。ファイルが添付できないメールシステムでExcelファイルを送信するとか?
Sub ワークブックをXMLで書き出す()
Const myfilename = "myfile.xml"
desktop_path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & ""
mytext = make_xml_book()
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText mytext, 1
.SaveToFile desktop_path & myfilename, 2
.Close
End With
End Sub
Function make_xml_book()
mytext = ""
mytext = mytext & "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>"
mytext = mytext & "<?mso-application progid=" & Chr(34) & "Excel.Sheet" & Chr(34) & "?>"
mytext = mytext & "<Workbook xmlns=" & Chr(34) & "urn:schemas-microsoft-com:office:spreadsheet" & Chr(34) & ">"
For i = 1 To Sheets.Count
Sheets(i).Activate
mytext = mytext & make_xml_sheet()
Next i
mytext = mytext & "</Workbook>"
make_xml_book = mytext
End Function
Function make_xml_sheet()
Const numr = 100 '行の下端
Const numc = 100 '列の右端
ReDim mycells(numr, numc)
Dim c, r, myformula
mysheetname = ActiveSheet.Name
rowmax = 0
colmax = 0
For r = 1 To numr
For c = 1 To numc
myformula = Cells(r, c).Formula
If myformula <> "" Then
Cells(r, c).Select
If Left(myformula, 1) = "=" Then
myformula = Application.ConvertFormula(Formula:=myformula, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1)
mycells(r, c) = "<Cell ss:Formula=" & Chr(34) & myformula & Chr(34) & "></Cell>"
Else
If IsNumeric(myformula) Then
num_str = "Number"
Else
num_str = "String"
End If
mycells(r, c) = "<Cell><Data ss:Type=" & Chr(34) & num_str & Chr(34) & ">" & myformula & "</Data></Cell>"
End If
If rowmax < r Then rowmax = r
If colmax < c Then colmax = c
End If
Next c
Next r
mytext = ""
mytext = mytext & "<Worksheet ss:Name=" & Chr(34) & mysheetname & Chr(34) & ">"
mytext = mytext & "<Table>"
For r = 1 To rowmax
mytext = mytext & "<Row>"
For c = 1 To colmax
If mycells(r, c) = "" Then
mytext = mytext & "<Cell></Cell>"
Else
mytext = mytext & mycells(r, c)
End If
Next c
mytext = mytext & "</Row>"
Next r
mytext = mytext & "</Table>"
mytext = mytext & "</Worksheet>"
make_xml_sheet = mytext
End Function
Const myfilename = "myfile.xml"
desktop_path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & ""
mytext = make_xml_book()
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText mytext, 1
.SaveToFile desktop_path & myfilename, 2
.Close
End With
End Sub
Function make_xml_book()
mytext = ""
mytext = mytext & "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>"
mytext = mytext & "<?mso-application progid=" & Chr(34) & "Excel.Sheet" & Chr(34) & "?>"
mytext = mytext & "<Workbook xmlns=" & Chr(34) & "urn:schemas-microsoft-com:office:spreadsheet" & Chr(34) & ">"
For i = 1 To Sheets.Count
Sheets(i).Activate
mytext = mytext & make_xml_sheet()
Next i
mytext = mytext & "</Workbook>"
make_xml_book = mytext
End Function
Function make_xml_sheet()
Const numr = 100 '行の下端
Const numc = 100 '列の右端
ReDim mycells(numr, numc)
Dim c, r, myformula
mysheetname = ActiveSheet.Name
rowmax = 0
colmax = 0
For r = 1 To numr
For c = 1 To numc
myformula = Cells(r, c).Formula
If myformula <> "" Then
Cells(r, c).Select
If Left(myformula, 1) = "=" Then
myformula = Application.ConvertFormula(Formula:=myformula, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1)
mycells(r, c) = "<Cell ss:Formula=" & Chr(34) & myformula & Chr(34) & "></Cell>"
Else
If IsNumeric(myformula) Then
num_str = "Number"
Else
num_str = "String"
End If
mycells(r, c) = "<Cell><Data ss:Type=" & Chr(34) & num_str & Chr(34) & ">" & myformula & "</Data></Cell>"
End If
If rowmax < r Then rowmax = r
If colmax < c Then colmax = c
End If
Next c
Next r
mytext = ""
mytext = mytext & "<Worksheet ss:Name=" & Chr(34) & mysheetname & Chr(34) & ">"
mytext = mytext & "<Table>"
For r = 1 To rowmax
mytext = mytext & "<Row>"
For c = 1 To colmax
If mycells(r, c) = "" Then
mytext = mytext & "<Cell></Cell>"
Else
mytext = mytext & mycells(r, c)
End If
Next c
mytext = mytext & "</Row>"
Next r
mytext = mytext & "</Table>"
mytext = mytext & "</Worksheet>"
make_xml_sheet = mytext
End Function
コメント