仕事柄、マイクロソフトのExcelからは逃げられません。もう呪いですよここまで来ると。
サーバーに置かれた誰が作ったかも判らないエクセルファイルを使っていろいろデータのやりとりを日々行っているわけですが、いろんな部署から不特定多数のアクセスがあると、知らない間にいろいろと汚染されていることがあります。
例えばスタイル。恐ろしい数のスタイルがいつの間にか設定されており、ファイルサイズが膨れ上がったり、旧ファイル形式では書式の破壊を引き起こしたり。
これはマイクロソフトの公式でも「スタイル削除のVBA」を公開するほどの公認不具合ですが、どういうわけかこれでは消せない、手動で削除しても消せない完全なるゴミスタイルがあったりして気分が悪いです。
ゴミスタイルの名前に特定地域の地名が入ってたりすることから該当支店がなにかやらかしてるんだと思うんですが、イタチごっこになっていて手がつけられません。タチの悪いことに、これらのゴミスタイルはセルのコピーやシートのコピーを機会に別ファイルに乗り移ったりします。
そしてもう一つ、外部参照の残骸です。
どうしても消えない、どこに設定されているか判らないリンクが悩みの種でした。
Google先生などで訊いてみても、出てくるのは「リンクの編集で参照元を変更する」とか「名前に設定されている場合は名前の管理から消す」とか「条件付き書式に設定されている場合は〜」「オブジェクトに設定されている場合は～」とか。
全部確認しました、シートのどこにも、オブジェクトのどこにも、名前にも条件付き書式にも該当のリンクは見つかりません。リンクの解除も受け付けない、これは一体どうすればいいのか。
意外なところに手段が転がっていました。
実はExcelのファイル形式、.xlsxや.xlsmはzipファイルなんですって。へー。
ものは試しに拡張子をzipに変えてみると……おお、確かに内部データが見えます。
「xl」フォルダの中身を見ていくと、さらにいくつかのデータとフォルダが。その中に「externalLinks」というフォルダを開くと、「externalLink1.xml」のファイルと「_rels」というフォルダが。そのフォルダの中には「externalLink1.xml.rels」というファイルが。
ファイルを開いてみると……消せなかったゴミリンクが記載されているではありませんか。
これらのファイルを削除すると、なぜかexternalLinksのフォルダ自体が消えました。拡張子を元に戻し、ファイルを開くと、参照できない値が云々と言われてファイルの修復が始まりました。修復が終わると……リンク消えてますね。
もう一つ、スタイルの件。xlフォルダの配下に「styles.xml」というファイルがありました。 zipファイルの中身を直接編集はできないので、一旦デスクトップ等に「styles.xml」をコピー。これをテキストエディタで開きます。
「styles.xml」の中身はたった2行のテキスト……しかし、ファイルサイズは10MB超えてたりしますから、どれだけ見づらいか。テキストエディタで右端で折り返す、等の措置を執らないととてもじゃないが見られたものではありません。
「<csllStyles count="(数字)">」から始まって「</cellStyles>」で終わるタグ？ の中に「<cellStyle name=」で始まる無数のスタイルがあります。その中には消せなかったスタイルが記載されています。
これを削除……ただし、全て削除してしまうとファイル内の書式が破壊されてしまう事象を確認したので、どれか最低一つは残す必要があるようです。
xfId="0"の"標準"だけ残して消してしまいます。
ファイルをzipに戻して拡張子を元に戻してファイルを開くと、今まで消せなかったゴミスタイルが消えていました。
このファイルを上書き保存して、再度zip化してstyles.xmlを確認すると、先ほどのcountは3に修正され、デフォルトだけに戻るようです。この際、cellStyle name以外のゴミも自動で取り除かれるようです。上書き保存して一連の作業は完了、ということですね。
方法としてはものすごい邪道だと思うんですが、もし同様の悩みを抱えている方がいたら「自己責任において」試してみてはいかがでしょうか。下手すりゃファイルが壊れる方法なので、当然バックアップを取ってから。
追記：
外に引っ張り出してきたstyle.xmlから余分なスタイルを削除するコードです。
ダイアログからstyle.xmlを選択すればOK……ただし、「標準」のスタイルが残っていないと書き込みを行いません（スタイル全削除になってファイルが壊れるからです）。
しつこいようですが、バックアップは確実に取ってから実行してください。
Sub style_xml編集()
Dim fName As String
Dim i As Long
Dim Buf As String
Dim Style
Dim Tmp
Dim e As Boolean
fName = Application.GetOpenFilename("スタイル,*.xml")
If fName = "False" Then End
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile fName
Buf = .readtext
.Close
End With
Style = Split(Buf, vbCrLf)
Tmp = Split(Style(1), ">")
Style(1) = ""
For i = 0 To UBound(Tmp) - 1
If Left(Tmp(i), 16) = "<cellStyle name=" Then
If InStr(Tmp(i), "<cellStyle name=""標準"" xfId=""0""") > 0 Then
Style(1) = Style(1) & Tmp(i) & ">"
e = True
End If
Else
Style(1) = Style(1) & Tmp(i) & ">"
End If
Next i
If e = False Then
MsgBox "標準 xfId=""0""のスタイルが見つかりませんでした。処理を中止します"
End
End If
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.writetext Style(0), 1
.writetext Style(1), 0
.savetofile fName, 2
.Close
End With
End Sub
追記：
スタイルを自動で消せる部分は消してしまいましょう、ということで、私が使っているスタイル削除です。
消せないスタイルがあった場合は警告を出しますので、その場合は上記のstyle_xml編集を使用して消すようにしています。
あと、無駄に処理時間を出すようにしています。通常用途では必要無いはずです。
……スタイル削除をサボってると、こんだけ時間を無駄にしますよ、ということを職場に知らしめるためです。スタイル数5万を超えるようなファイルがゴロゴロしていましたので。
Sub スタイル削除()
Application.ScreenUpdating = False
Dim fName As String
Dim bName As String
Dim a As Long
Dim c As Long
Dim z As Long
Dim s As Object
Dim w As Worksheet
Dim sTime As Date
Dim eTime As Date
z = Cells(Rows.count, 1).End(xlUp).Row + 1
If z < 5 Then z = 5
fName = Application.GetOpenFilename("スタイル削除,*.xls*")
If fName = "False" Then End
Workbooks.Open (fName), ReadOnly:=True
sTime = Now
bName = ActiveWorkbook.Name
bName = Left(bName, InStr(bName, ".xls") - 1) & "after" & Mid(bName, InStr(bName, ".xls"))
For Each w In Worksheets
If w.ProtectContents = True Then w.Unprotect
Next
On Error Resume Next
For Each s In ActiveWorkbook.Styles
If Not s.BuiltIn Then
s.Delete
c = c + 1
End If
If Err.Number = 1004 Then
a = a + 1
Err.Number = 0
End If
Next
ActiveWorkbook.Close SaveChanges:=True, Filename:=ActiveWorkbook.Path & "\" & bName
Cells(z, 1).Value = fName
Cells(z, 2).Value = c
eTime = Now
Cells(z, 3).NumberFormatLocal = "h:mm:ss"
Cells(z, 3) = Format(eTime - sTime, "h:mm:ss")
If a > 0 Then
Cells(z, 1).Interior.ColorIndex = 6
MsgBox "消せなかったスタイルが存在します。style.xmlの直接修正が必要です", vbExclamation
End If
Application.ScreenUpdating = True
End Sub