feat: add AI written VBA

winword/migration.vba

@@ -0,0 +1,170 @@
+Sub MapAndDeleteStyles()
+    ' 样式映射字典
+    ' 格式：源样式名称 -> 目标样式名称
+    Dim styleMappings As Object
+    Set styleMappings = CreateObject("Scripting.Dictionary")
+    
+    ' ===== 在这里配置你的样式映射关系 =====
+    ' 示例：
+    styleMappings.Add "Heading 1", "标题1"
+    styleMappings.Add "Heading 2", "标题2"
+    styleMappings.Add "Normal", "正文"
+    styleMappings.Add "List Paragraph", "列表段落"
+    styleMappings.Add "Caption", "题注"
+    ' 添加更多映射...
+    ' ====================================
+    
+    Dim srcStyleName As Variant
+    Dim targetStyleName As String
+    Dim srcStyle As Style
+    Dim targetStyle As Style
+    Dim doc As Document
+    Dim para As Paragraph
+    Dim rng As Range
+    Dim styleExists As Boolean
+    Dim convertedCount As Long
+    
+    Set doc = ActiveDocument
+    convertedCount = 0
+    
+    ' 禁用屏幕更新以提高性能
+    Application.ScreenUpdating = False
+    
+    ' 首先验证所有目标样式是否存在
+    For Each srcStyleName In styleMappings.Keys
+        targetStyleName = styleMappings(srcStyleName)
+        On Error Resume Next
+        Set targetStyle = doc.Styles(targetStyleName)
+        On Error GoTo 0
+        
+        If targetStyle Is Nothing Then
+            MsgBox "目标样式 '" & targetStyleName & "' 不存在于文档中！" & vbCrLf & _
+                   "请先创建该样式或修改映射关系。", vbExclamation, "样式不存在"
+            Application.ScreenUpdating = True
+            Exit Sub
+        End If
+        Set targetStyle = Nothing
+    Next srcStyleName
+    
+    ' 遍历文档中所有段落
+    For Each para In doc.Paragraphs
+        srcStyleName = para.Style.NameLocal
+        
+        ' 检查当前段落的样式是否需要映射
+        If styleMappings.exists(srcStyleName) Then
+            targetStyleName = styleMappings(srcStyleName)
+            
+            ' 应用目标样式
+            para.Style = targetStyleName
+            convertedCount = convertedCount + 1
+        End If
+    Next para
+    
+    ' 处理表格单元格内的文本（段落样式可能不同）
+    Dim tbl As Table
+    Dim cell As Cell
+    For Each tbl In doc.Tables
+        For Each cell In tbl.Range.Cells
+            For Each para In cell.Range.Paragraphs
+                srcStyleName = para.Style.NameLocal
+                If styleMappings.exists(srcStyleName) Then
+                    targetStyleName = styleMappings(srcStyleName)
+                    para.Style = targetStyleName
+                    convertedCount = convertedCount + 1
+                End If
+            Next para
+        Next cell
+    Next tbl
+    
+    ' 删除源样式
+    Dim stylesToDelete As Object
+    Set stylesToDelete = CreateObject("Scripting.Dictionary")
+    
+    For Each srcStyleName In styleMappings.Keys
+        On Error Resume Next
+        Set srcStyle = doc.Styles(srcStyleName)
+        On Error GoTo 0
+        
+        If Not srcStyle Is Nothing Then
+            ' 检查是否为内置样式（内置样式无法删除）
+            If srcStyle.BuiltIn Then
+                MsgBox "样式 '" & srcStyleName & "' 是Word内置样式，无法删除。" & vbCrLf & _
+                       "已将其文本转换为目标样式，但样式本身保留。", vbInformation, "内置样式"
+            Else
+                stylesToDelete.Add srcStyleName, True
+            End If
+        End If
+        Set srcStyle = Nothing
+    Next srcStyleName
+    
+    ' 执行删除自定义样式
+    Dim deleteCount As Long
+    deleteCount = 0
+    
+    For Each srcStyleName In stylesToDelete.Keys
+        On Error Resume Next
+        Set srcStyle = doc.Styles(srcStyleName)
+        On Error GoTo 0
+        
+        If Not srcStyle Is Nothing Then
+            ' 检查是否还有任何内容使用该样式
+            If Not IsStyleInUse(doc, srcStyleName) Then
+                srcStyle.Delete
+                deleteCount = deleteCount + 1
+            Else
+                MsgBox "样式 '" & srcStyleName & "' 可能仍被某些内容使用，无法安全删除。", _
+                       vbExclamation, "样式仍在使用"
+            End If
+        End If
+    Next srcStyleName
+    
+    ' 恢复屏幕更新
+    Application.ScreenUpdating = True
+    
+    ' 显示结果
+    MsgBox "完成！" & vbCrLf & _
+           "转换的段落/单元格数量: " & convertedCount & vbCrLf & _
+           "删除的样式数量: " & deleteCount, vbInformation, "样式映射完成"
+End Sub
+
+' 辅助函数：检查样式是否还在文档中使用
+Function IsStyleInUse(doc As Document, styleName As String) As Boolean
+    Dim rng As Range
+    Dim para As Paragraph
+    
+    ' 检查段落
+    For Each para In doc.Paragraphs
+        If para.Style.NameLocal = styleName Then
+            IsStyleInUse = True
+            Exit Function
+        End If
+    Next para
+    
+    ' 检查表格单元格
+    Dim tbl As Table
+    Dim cell As Cell
+    For Each tbl In doc.Tables
+        For Each cell In tbl.Range.Cells
+            For Each para In cell.Range.Paragraphs
+                If para.Style.NameLocal = styleName Then
+                    IsStyleInUse = True
+                    Exit Function
+                End If
+            Next para
+        Next cell
+    Next tbl
+    
+    ' 检查字符样式（直接应用在字符上）
+    Dim charRng As Range
+    Set rng = doc.Range
+    With rng.Find
+        .ClearFormatting
+        .Style = styleName
+        If .Execute(FindText:="") Then
+            IsStyleInUse = True
+            Exit Function
+        End If
+    End With
+    
+    IsStyleInUse = False
+End Function