Удалить листы без цвета, удалить комментарии со всех листов, разорвать ссылки на все источники - PullRequest
Новая
       15

Удалить листы без цвета, удалить комментарии со всех листов, разорвать ссылки на все источники

0 голосов
/ 06 ноября 2018

В настоящее время я работаю над своим первым макросом VBA для запуска функций, описанных в заголовке. В настоящее время у меня есть следующий код.

Похоже, что он работает как задумано, но мне бы хотелось, чтобы второй взгляд сказал мне, есть ли у меня какие-либо непредвиденные последствия или есть более устойчивые способы написать это. Заранее спасибо, КП. 

'
' deletecomments Macro
' delete comments, removetabs, break links for rolling models
'
' Keyboard Shortcut: Ctrl+alt+R
'
Public Sub RollModel()
Dim ws As Worksheet, cmt As Comment

For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
cmt.Delete
Next cmt
Next ws

   On Error Resume Next
   For Each it In ThisWorkbook.LinkSources
       For Each sh In Sheets
         sh.Cells.Replace it, ""
          For Each cl In sh.UsedRange.SpecialCells(-4174)
             If InStr(cl.Validation.Formula1, "#REF") Then cl.Validation.Delete
          Next
       Next
       ThisWorkbook.BreakLink it, 1
    Next

Application.DisplayAlerts = False
Dim Sht As Worksheet

For Each Sht In Worksheets
    If Sht.Tab.ColorIndex = xlColorIndexNone Then Sht.Delete
Next

Application.DisplayAlerts = True

End Sub

1 Ответ

0 голосов
/ 06 ноября 2018

Я уверен, что кто-то другой может дать вам лучший ответ, но это всего лишь некоторые вещи, которые я заметил.

  • Необъявленные переменные обрабатываются как варианты
  • При возобновлении ошибки далее будут подавлены все ошибки, а не только те, которые вы пытаетесь игнорировать
  • Sheets коллекция может включать в себя таблицы диаграмм, если таковые имеются в вашей книге, тогда как Worksheets нет.

Также, извините за плохое форматирование. Написано на мобильном телефоне. Непроверенные. 

Option Explicit

Public Sub RollModel()

With thisworkbook

Dim ws As Worksheet

For Each ws In .Worksheets
Ws.cells.clearcomments
Next ws

' I assume your on error resume next was because when there are no LinkSources, vbempty is returned instead of an array -- which you can't iterate over '

' Also, this method can also return a 2 dimensional array according to https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.linksources -- which would cause an error as array indexes below are one-dimensional '

Dim linkArray as variant
Linkarray = .linksources

Dim linkIndex as long
Dim cell as range

If not isempty(linkarray) then

For linkIndex = Lbound(linkarray) to ubound(linkarray)

For Each ws In .Worksheets

Ws.cells.replace linkarray(linkIndex), ""

For Each cell In ws.cells.SpecialCells(xlCellTypeAllValidation)
If InStr(cell.Validation.Formula1, "#REF") Then
cl.Validation.Delete ' Not sure if this is the best way/approach, so have not really changed it.'
End if
Next cell

Next ws

.BreakLink linkarray(linkIndex), xlLinkTypeExcelLinks

Next linkIndex

End if

For Each ws In .Worksheets

If ws.Tab.ColorIndex = xlColorIndexNone Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

Next ws

End With

End Sub
...