[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザー定義の一括削除』（panda）
マクロ初心者なのです。
長年にわたりいろんな人がいじったファイルなので書式のユーザー定義を一括削除したく、ネットで調べて作ったのですが削除されません。。。
アドバイスをお願いいたします。
Sub ユーザー設定スタイル一括削除2()
Dim oSty As Style Dim arySty() As Variant Dim i As Long Dim flg As Boolean
'== 残したいスタイルの名前 =====
arySty = Array("[$-ja-JP]ge.m.d;@", "[$-ja-JP]ge.mm.dd;@", "yyyy/mm/dd", "h:mm;@", "#,##0.0", "0.0_ ", "0.00_ ")
For Each oSty In ActiveWorkbook.Styles
'ビルトインスタイル（削除不可）以外を削除
If oSty.BuiltIn = False Then
flg = True
For i = 0 To UBound(arySty)
If oSty.NameLocal = arySty(i) Then
flg = False
Exit For
End If
Next i
If flg = True Then oSty.Delete
End If
Next
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
https://koukimra.com/archives/304
（調査1班） 2023/12/25(月) 15:47:36
わたしも書式のことかと思いましたが、書式は消えず。
（セル）スタイルを登録したところ、きちんと削除されました。
（ゆたか） 2023/12/25(月) 16:15:33
おそらく、ユーザー定義の表示形式 を消したいのだと思いますが、 ActiveWorkbook.DeleteNumberFormat で消せるのですが、 消す書式を引数で与えないといけません。
ところが、ユーザー定義の表示形式を列挙するメソッドやプロパティが無いので、 かなり力ずくというかなんというか ↓ https://bettersolutions.com/excel/formatting/vba-delete-unused-custom-formats.htm （´・ω・`） 2023/12/25(月) 16:41:26
メモです ユーザー定義の表示形式の一覧の取得方法 (1) ブックの拡張子をZIPに変更 (2) xlフォルダのstyles.xml を読む (3) XPATH //numFmt/@formatCode で取得 =FILTERXML(XMLファイルの中身,"//numFmt/@formatCode") （´・ω・`） 2023/12/25(月) 17:25:35
>ユーザー定義の表示形式の一覧の取得方法
興味をそそる内容だったので、（´・ω・`）さんの案をPowerShellでやってみました。 PowerShellでは、ユーザー定義の表示形式をクリップボードに格納までです。 実行後、手動で、Excelに貼り付けです。 検証不十分ですが、手元の環境では、一応それっぽい文字列は、取得できているみたいです。 只、「\」の変換が複雑で、単純に「!」変換ではダメみたいです。
#PowerShell
Add-Type -AssemblyName System.Windows.Forms
$dialog = New-Object System.Windows.Forms.OpenFileDialog
$dialog.Filter = "Excelファイル|*.xlsx;*.xlsm;*.xlst"
if($dialog.ShowDialog() -eq [System.Windows.Forms.DialogResult]::Cancel){exit}
$bookPath=$dialog.FileName
$tmpPath=$env:temp+"\ExcelZip"
New-Item $tmpPath -ItemType "directory" -Force
$zipPath=Join-Path -Path $tmpPath -ChildPath ((Get-Item $bookPath).BaseName+'.zip')
Copy-Item $bookPath $zipPath
Expand-Archive -Path $zipPath -DestinationPath $tmpPath -Force
$stylePath=Join-Path -Path $tmpPath -ChildPath 'xl\styles.xml'
$str=Get-Content -Path $stylePath -Encoding UTF8 -Raw
$mc = [RegEx]::Matches($str, '(?<=<numFmts.*formatCode=").*?(?=".*/numFmts>)')
$list = [System.Collections.Generic.List[string]]::new()
for ($i = 0; $i -lt $mc.Count; $i++) {
$fm=[System.Net.WebUtility]::HtmlDecode($mc[$i].Value)
$list.Add($fm)}
if ($list.Count -gt 0){$list | Set-Clipboard} else {Set-Clipboard 'ユーザー定義の表示形式は、ありません！'}
Remove-Item $tmpPath -Recurse -Force
（まる2021） 2023/12/26(火) 09:23:15
>「\」の変換が複雑で、単純に「!」変換ではダメみたいです。 取得できた文字列をそのまま DeleteNumberFormat に渡せば大丈夫みたいですよ
Sub test()
DeleteNumFormat ActiveWorkbook
End Sub
Sub DeleteNumFormat(wb As Workbook)
Dim FSO As Object
Dim TMPFolder As Object, ZipPath As String, XML As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TMPFolder = FSO.CreateFolder(FSO.GetSpecialFolder(2) & "\" & FSO.GetBaseName(FSO.GetTempName))
ZipPath = TMPFolder.Path & "\" & FSO.GetBaseName(wb.Name) & ".zip"
FSO.CopyFile wb.FullName, ZipPath
With CreateObject("Shell.Application")
.Namespace(TMPFolder.Path).CopyHere ZipPath & "\xl\styles.xml"
End With
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile TMPFolder & "\styles.xml"
XML = .ReadText
.Close
End With
TMPFolder.Delete
Dim numFMT As Long, FMT As Variant
On Error Resume Next
numFMT = WorksheetFunction.FilterXML(XML, "//numFmts/@count")
On Error GoTo 0
If numFMT = 0 Then Exit Sub
FMTS = WorksheetFunction.FilterXML(XML, "//numFmt/@formatCode")
If IsArray(FMTS) Then
For i = 1 To numFMT
wb.DeleteNumberFormat FMTS(i, 1)
Next
Else
wb.DeleteNumberFormat FMTS
End If
End Sub
（´・ω・`） 2023/12/26(火) 10:07:04
初心者なので、（´・ω・`）さん、まる2021さんに教えていただいた内容に追いつけないのですが、教えていただいたURL先のマクロ全文をコピーして貼り付け、実行してみましたがうまくいきませんでした。
「ユーザー定義の表示形式の一覧の取得方法」で取得した中で不要なものを ActiveWorkbook.DeleteNumberFormatで削除する、ということでしょうか。
（panda） 2023/12/26(火) 10:17:47
>「ユーザー定義の表示形式の一覧の取得方法」で取得した中で不要なものを > ActiveWorkbook.DeleteNumberFormatで削除する、ということでしょうか そういうことなんですが、うまくいかないかも知れません （´・ω・`） 2023/12/26(火) 10:27:01
何度もお手数をおかけして申し訳ありません。
非常に勉強になります。
（panda） 2023/12/26(火) 10:35:12
>TMPFolder As Folder こっそり TMPFolder As Objectに修正してました 参照設定してればOKです
>表示形式は減っていませんでした。 エラーがでてないなら分かりません 私のマクロは問答無用で、ユーザー設定の表示形式を削除しようとしますが ・対象ブックを指定する必要がありますが、そのブックは実行前に保存しておく必要があります。 ・まるさんがおっしゃるとおり、取得した表示形式の文字列は \ でエスケープされていますが、 この変換が難しい。削除したくない書式との文字列比較が困難です ・表示形式の文字列に \ そのものが含まれていると、DeleteNumberFormatで失敗するかも （´・ω・`） 2023/12/26(火) 10:52:03
対象のブックをコピーして.xlsm形式で保存しマクロを実行しているのですが、「対象ブックを指定する」ということは、どこかにファイル名を入れなければいけないということで合っていますでしょうか。
（panda） 2023/12/26(火) 11:13:08
いまは
Sub test()
DeleteNumFormat ActiveWorkbook
End Sub
とActiveWorkbookを対象にしています。ご自由に書き換えてください。
さて、どうもうまくいきません
以下のコードで \ #,### という表示形式が削除できません（エラーにもならない）
ActiveCell.NumberFormatLocal = "\ #,###"
ActiveCell.FormulaR1C1 = "1000"
ActiveWorkbook.DeleteNumberFormat NumberFormat:="\ #,###"
styles.xmlには <numFmt numFmtId="177" formatCode="&ｑuot;\&ｑuot;\ #,###"/> (qをｑにしてます) のように格納されていて、FILTERXML関数でこれを取得すると "\"\ #,### となります。 これを DeleteNumberFormat に渡しても削除できません
ギブアップ （´・ω・`） 2023/12/26(火) 12:14:41
XMLの場合、「"<>&」等の特殊文字は「&」で始まる形にエンコードされるので、これをデコードする必要があります。 これが面倒なので、PowerShellで書きました。 でも（´・ω・`）さんの回答を読んで、再度、試したら、FILTERXML関数でデコードできますね。優秀だな... http://web-dou.com/html/t023.html
>pandaさん 自分のはVBAではないので、VBEにコピペしても、動きません。 (1)メモ帳にコピペして、UTF8(BOM付)で拡張子「ps1」で保存、 (2)それを右クリックして「PowerShellで実行」、 (3)クリップボードに結果が格納されているので、EXCELで貼り付け です。表示形式の削除は行いません。ここまでで、想定通りの結果が得られていれば削除は簡単で、 WorkbookオブジェクトのDeleteNumberFormatメソッド を実行するだけです。 只、前回も書きましたが「\」の変換が複雑で、汎用的なコードを書くのは大変で、自分もギブアップです。
PowerShellを使ったことがないなら、ちょっと敷居が高いので無視してください。 どの程度の数か知りませんが、マクロ初心者というなら、手動で1つ1つ削除していくのが確実では..と思います。 （まる2021） 2023/12/26(火) 12:44:15
整理したいファイルの数が100以上あり、ファイルによってユーザー定義の表示形式数も順番も異なるので、全て削除した上で、新たに定義すればいいのかなと思った次第です。
初心者に優しくお付き合いいただきありがとうございました。
（panda） 2023/12/26(火) 13:15:01
「G/標準」以外を消すかどうか聞いてくるみたいですが、
ここに消したくない表示形式を追加することは可能です。
ただし、必要な表示形式は本当に把握できているのか？
という問題はあるような気がします。一応、表示確認してますが。
また、そのままでは自分のブックのみを対象にしているので。。。
そうですね、真面目に使おうと思えば、複数ブックを順に処理するとか、
そういうことは考えないとだめでしょうね。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11239973511
参考まで。
（ゆたか） 2023/12/26(火) 14:34:32
ちょと進展
ActiveCell.NumberFormatLocal = "\ #,###"
ActiveCell.FormulaR1C1 = "1000"
ActiveWorkbook.DeleteNumberFormat NumberFormat:="\ #,###" ' 削除できない
ActiveWorkbook.DeleteNumberFormat NumberFormat:="$ #,###" ' 削除できた
なるほど...
（´・ω・`） 2023/12/26(火) 15:01:11
改良しました が、どこまで対応できたかはわかりません
Sub test()
DeleteNumFormat ActiveWorkbook
End Sub
Sub DeleteNumFormat(wb As Workbook)
Dim FSO As Object
Dim TMPFolder As Object, ZipPath As String, xml As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TMPFolder = FSO.CreateFolder(FSO.GetSpecialFolder(2) & "\" & FSO.GetBaseName(FSO.GetTempName))
ZipPath = TMPFolder.Path & "\" & FSO.GetBaseName(wb.Name) & ".zip"
FSO.CopyFile wb.FullName, ZipPath
With CreateObject("Shell.Application")
.Namespace(TMPFolder.Path).CopyHere ZipPath & "\xl\styles.xml"
End With
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile TMPFolder & "\styles.xml"
xml = .ReadText
.Close
End With
TMPFolder.Delete
Dim numFMT As Long, FMT As Variant
On Error Resume Next
numFMT = WorksheetFunction.FilterXML(xml, "//numFmts/@count")
On Error GoTo 0
If numFMT = 0 Then Exit Sub
fmts = WorksheetFunction.FilterXML(xml, "//numFmt/@formatCode")
If IsArray(fmts) Then
For i = 1 To numFMT
fmts(i, 1) = Replace(fmts(i, 1), """" & ChrW(165) & """", """$""")
If Right(fmts, 1) = "_" Then fmts = fmts & " "
wb.DeleteNumberFormat fmts(i, 1)
Next
Else
Range("A1").Value = fmts
fmts = Replace(fmts, """" & ChrW(165) & """", """$""")
If Right(fmts, 1) = "_" Then fmts = fmts & " "
wb.DeleteNumberFormat fmts
End If
End Sub
（´・ω・`） 2023/12/26(火) 15:14:05
改良しました ・FILTERXML関数は文字列の最後の空白文字を削除しちゃうので、FILTERXML関数じゃない方法にしました ・EnumNumFormatは Dictionaryでユーザー定義の表示形式をリストアップだけをします
Sub test()
Dim wb As Workbook
Dim fmtList As Object, fmt As Variant
Set wb = ActiveWorkbook
Set fmtList = EnumNumFormat(wb)
For Each fmt In fmtList.keys
If MsgBox(fmt & "を削除しますか", vbYesNo) = vbYes Then
wb.DeleteNumberFormat fmtList(fmt)
End If
Next
End Sub
Function EnumNumFormat(wb As Workbook) As Object
Dim FSO As Object
Dim TMPFolder As Object, ZipPath As String
Dim xml As Object, fmt As Object, innerFmtstr As String, outerFmtstr As String
Dim loadOK As Boolean
Dim fmtList As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TMPFolder = FSO.CreateFolder(FSO.GetSpecialFolder(2) & "\" & FSO.GetBaseName(FSO.GetTempName))
ZipPath = TMPFolder.Path & "\" & FSO.GetBaseName(wb.Name) & ".zip"
FSO.CopyFile wb.FullName, ZipPath
With CreateObject("Shell.Application")
.Namespace(TMPFolder.Path).CopyHere ZipPath & "\xl\styles.xml"
End With
Set xml = CreateObject("MSXML2.DOMDocument.6.0")
loadOK = xml.Load(TMPFolder & "\styles.xml")
TMPFolder.Delete
If Not loadOK Then Exit Function
Set fmtList = CreateObject("Scripting.Dictionary")
xml.setProperty "SelectionLanguage", "XPath"
xml.setProperty "SelectionNamespaces", "xmlns:a='http://schemas.openxmlformats.org/spreadsheetml/2006/main'"
For Each fmt In xml.SelectNodes("//a:numFmt")
innerFmtstr = fmt.getAttribute("formatCode")
innerFmtstr = Replace(innerFmtstr, """" & ChrW(165) & """", """$""")
outerFmtstr = Replace(Replace(innerFmtstr, "\", ""), """$""", "\")
If Not fmtList.Exists(outerFmtstr) Then
fmtList.Add outerFmtstr, innerFmtstr
End If Next
Set EnumNumFormat = fmtList
End Function
（´・ω・`） 2023/12/26(火) 16:33:49
Sub main()
For Each formatCode In GetFormatCode("C:\UserName\Book.xlsx")
Debug.Print formatCode
Next
End Sub
Function GetFormatCode(xmlFormatExcelBookPath As String) As String()
Dim PSScript As String: PSScript = Join(Array( _
"$OutputEncoding = [System.Text.Encoding]::GetEncoding('utf-16')", _
"Add-Type -AssemblyName 'System.IO.Compression.FileSystem'", _
"$stm = New-Object System.IO.StreamReader(" & _
"[System.IO.Compression.ZipFile]::OpenRead('" & xmlFormatExcelBookPath & "').GetEntry('xl/styles.xml').Open()" & _
")", _
"[xml]$xml = $stm.ReadToEnd()", _
"$stm.close()", _
"Set-Clipboard", _
"foreach($formatCode in $xml.styleSheet.numFmts.numFmt.formatCode)" & _
"{Set-Clipboard -Append $formatCode.Replace('\ ',' ').Replace('""""" & ChrW(&HA5) & """""""','\')}" _
), ";")
CreateObject("WScript.Shell").Run "PowerShell """ & PSScript & """", 0, True
GetFormatCode = Split(CreateObject("htmlfile").ParentWindow.clipboardData.GetData("text"), vbCrLf)
End Function
（とりあえず） 2023/12/26(火) 21:43:44
ゆたかさんが教えてくださったURLのマクロは実は試してみました。
ユーザー定義が使われているセルの数だけメッセージボックスが出てくるので、確実ではあるけれどとても時間がかかってしまうのと、メッセージボックスで削除を選択するとエラーになってしまい、私の力量ではそこからどうアレンジしていいのかわからず、こちらで質問させていただきました。
（´・ω・`）さん、とりあえずさんに作成していただいたマクロは、時間を見つけて試してみます！
ひとまずお礼をお伝えさせたいただきます。
（panda） 2023/12/27(水) 14:29:55
ちょっとだけ修正しました
存在チェックするようにしました。 同じ書式が２つ登録されてることはないだろうと思ってましたが、念のため (手持ちのいくつかのブックで試したら、重複することもあるらしいので なぜか)
fmtList.Add outerFmtstr, innerFmtstr
↓
If Not fmtList.Exists(outerFmtstr) Then
fmtList.Add outerFmtstr, innerFmtstr
End If
メモ
・styles.xmlに登録されているformatCodeは (や空白文字など \でエスケープされているが
そのままDeleteNumberFormatに渡しても問題なく表示形式が削除される
・通貨記号"\"は、DeleteNumberFormatに渡す場合、$でなくてはならない
(DeleteNumberFormatLocalじゃない)
・通貨記号"\"はASCIIコード92(&H5C)ではなく、UNICODE 165(&HA5)
（´・ω・`） 2023/12/27(水) 14:57:42
しつこくて済みません
#,##0_);[赤](#,##0) という表示形式をマクロで消そうとするとエラーになります
ActiveCell.NumberFormatLocal = "#,##0_);[赤](#,##0)" ActiveWorkbook.DeleteNumberFormat NumberFormat:="#,##0_);[赤](#,##0)" ActiveWorkbook.DeleteNumberFormat NumberFormat:="#,##0_);[Red](#,##0)" ActiveWorkbook.DeleteNumberFormat NumberFormat:="#,##0_);[Red]\(#,##0\)"
いずれも 1004 'DeleteNumberFormat' メソッドは失敗しました: '_Workbook' オブジェクト
なぜでしょう？ （´・ω・`） 2023/12/27(水) 16:13:44
xml の参照関係が壊れる可能性があるので、バックアップとかコピーとか用意してから
実行してください
ブックが壊れても責任等は取れません
Sub main()
Call EraseNumFmts("C:\UserPath\Documents\numFmts - コピー.xlsx")
End Sub
Sub EraseNumFmts(BookFullPath As String)
' Book 内の styles.xml から <numFmts> - </numFmts> を削除します
' 不具合が発生する可能性があるため、バックアップ等の対策実行後にお試しください
Const PSDelimiter = ";"
' System.IO.Compression.ZipFile 使用に必要
Dim Imports As String: Imports = "Add-Type -AssemblyName 'System.IO.Compression.FileSystem'"
' 操作に必要な ZipFile を取得
' https://learn.microsoft.com/ja-jp/dotnet/api/system.io.compression.zipfile.open?view=net-8.0
Dim ZipFile As String: ZipFile = "$ZipArc = [System.IO.Compression.ZipFile]::Open('" & BookFullPath & "','UpDate')"
' xl/styles.xml 読み込み
Dim GetXml As String: GetXml = Join(Array( _
"$ZipArcEntry = $ZipArc.GetEntry('xl/styles.xml')", _
"$stm = New-Object System.IO.StreamReader($ZipArcEntry.Open())", _
"$txt = $stm.ReadToEnd()", _
"$stm.Close()"), PSDelimiter)
' styles.xml から <numFmts> を削除
Dim EraseNumFmts As String: EraseNumFmts = Join(Array( _
"$numFmtsXml = [regex]::Match($txt,'<numFmts.+?/numFmts>').Value", _
"$txt2 = $txt.Replace($numFmtsXml,'')"), PSDelimiter)
' xl/styles.xml を更新(削除して再作成、作成したファイルにテキスト書き込み)
Dim ReplaceXml As String: ReplaceXml = Join(Array( _
"$ZipArcEntry.Delete()", _
"$ZipArcEntry = $ZipArc.CreateEntry('xl/styles.xml')", _
"$stm = New-Object System.IO.StreamWriter($ZipArcEntry.Open())", _
"$stm.Write($txt2)", _
"$stm.Close()"), PSDelimiter)
' ZipFile リソースを解放 / これがないと更新されない？
' https://learn.microsoft.com/ja-jp/dotnet/api/system.io.compression.ziparchive.dispose?view=net-8.0
Dim ZipUpdate As String: ZipUpdate = "$ZipArc.Dispose()"
' PowerShell Script の組み立て
Dim PSScript As String: PSScript = Join(Array( _
Imports, _
ZipFile, _
GetXml, _
EraseNumFmts, _
ReplaceXml, _
ZipUpdate), PSDelimiter)
' 実行ポリシー / 端末設定によってはこれを指定しないと動作しない
' https://learn.microsoft.com/ja-jp/powershell/module/microsoft.powershell.core/about/about_execution_policies?view=powershell-5.1
Const execution_policies = "-ExecutionPolicy RemoteSigned"
Dim CMDLine As String: CMDLine = "PowerShell " & execution_policies & " """ & PSScript & """"
'Debug.Print CMDLine
CreateObject("WScript.Shell").Run CMDLine, 0, True
End Sub
（とりあえず） 2024/01/02(火) 00:04:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.