大量にできてしまったスタイルを削除する方法

Question

沢山の編集をしたブックでスタイルがあふれてしまい

セルのコピーができなくなってしまいました。

あるサイトからの引用で

以下のマクロを実行しましたが、削除されません。

Sub Default_Style()

    Dim dss

    On Error Resume Next

    Dim t

    t = ActiveWorkbook.Styles.Count

    For i = 1 To t

        dss = ActiveWorkbook.Styles.Item(i)

        If Not dss.BuiltIn Then

            dss.Delete

        End If

    Next

End Sub

tは5万くらいの大きな値でした。

3分くらいで完了しますが、スタイルは残ったままでした。

ちなみに異常に発生したスタイルの名前はどれも標準１０２０３４５のような

標準の後に数字がついたものです。

宜しくお願いいたします。

Answer 1

提示されたコードがそのまま掲載されていたとしたら、間違ってます。

 >dss = ActiveWorkbook.Styles.Item(i)

このｄｓｓはStyleつまりオブジェクトですから

Set　dss = ActiveWorkbook.Styles.Item(i)

とする必要があります。（これが決定的です）

次に、

>For i = 1 To t

削除を含むループを下からやると削除されたところより上のオブジェクトのインデックスが狂ってきますから

上の方からループする必要があります。（１ to t だと多分いくつかStyleが削除されずに残ると思います）

For i=t to 1 step -1

また、On error Resume next

でエラーの場合続行してますから、おかしくなっているのが分かりません。

これをはずしていれば、少なくともコードがおかしいことはすぐ分かったはずです。

↓のように修正してお試しください。

Sub Default_Style()

    Dim dss

    t = ActiveWorkbook.Styles.count

    For i = t To 1 Step -1

        Set dss = ActiveWorkbook.Styles.Item(i)

        If Not dss.BuiltIn Then

            dss.Delete

        End If

    Next

End Sub

Answer 2

i、tを見ると最初のスタイルでこけてます。

その　??_業務　の？は実際にそう表示されたのでしょうか？

そうであるとすると、推測ですが、壊れたスタイルが残っており、VBAからそれが削除できなかったということになります。

そのスタイルを手動で削除してからやってみてください。

もし、スタイルが沢山ありすぎて、見つけられない場合は、

Sub Default_Style()

    Dim dss

    t = ActiveWorkbook.Styles.count

On Error　Resume　Next

    For i = t To 1 Step -1

        Set dss = ActiveWorkbook.Styles.Item(i)

        If Not dss.BuiltIn Then

            dss.Delete

        End If

    Next

　On　Error go to 0

End Sub

として、Errorを無視して実行させれば、異常なスタイル以外は消えると思います。

Answer 3

BuiltInを使う方法は参考になりました。さっそく自作のVBSに取り込みました。

減算ループのかわりにFor Each を使っています。

このVBSへ xlsファイルをドラッグドロップすることで組み込みスタイル以外を除去できます。

'' excel-clear-junk-style.vbs

'' https://gist.github.com/hkuno9000/3f0cd3a0437d149276ca

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

For Each strFname In WScript.Arguments
Set objDoc = objExcel.Workbooks.Open(strFname)
' clear all names (comment out)
	For Each N In objDoc.Names
''		N.Delete
	Next
' clear all user style
	For Each S In objDoc.Styles
	If Not S.BuiltIn Then
		S.Delete
	End If
Next
objDoc.Save
objDoc.Close
Set objDoc = Nothing
Next

objExcel.Quit

Answer 4

このコードは特にExcelのバージョンは関係ありませんので、これだけの情報ではなにもわかりません。

dss.Deleteのところで止まっているのでしょうから、

その前の行にx=dss.Name 　とダミーを一行入れて置き、とまったところでｘ、i、ｔの値を確認して投稿ねがいます。

Answer 5

>ActiveWorkbook.Styles(dss).Delete

正確には

ActiveWorkbook.Styles(dss.Name).Delete

です。Styleのディフォールト（無指定の場合の）プロパティがNameであるため正しく動いています。

そんなに実行時間に差がでるとは思えないのですが・・・・・

ただ、名前を指定すると、名前を使ってすべてのStyleをチェックし該当のものを探し当てているのでIndexを番号で指定するよりは時間はかかると思います。