Excel VBA¦p¦óÀˬd_²Óªøª«¥ó¼Æ¶q

Andy2483

¦U¦ì«e½ú¦n
1.½Ð±Ð Àˬd_²Óªøª«¥ó¼Æ¶q ªºµ{¦¡½X
2.³oµ{¦¡ªº¥Øªº¬O¬°¤FÀˬd¦]Àx¦s®æ§R°£,¦Óª«¥ó³Q²Ó«ó¤ÆÂæb¤u§@ªí¸Ì,¸g¨Ï¥ÎªÌµL·N½Æ»s ¤£¦Ûª¾,¾É­PÀÉ®×Åܤj
2.1.¥H¤Uµ{¦¡½X¬O¦Û¤v·Qªº¤g¤èªk
3.¦³¨ä¥¦¤èªk¶Ü?
4.Andy·Q¶i¨B!½Ð«ü±Ð

½Ð¦U¦ì«e½ú«ü±Ð ÁÂÁÂ

Sub Àˬd_²Óªøª«¥ó¼Æ¶q()
Dim doN&, doNerr&, i&, msg$, SSH&, SHW&
With ActiveSheet.DrawingObjects
   If .Count = 0 Then
      GoTo 101
   End If
   For i = 1 To .Count
      doN = doN + 1
      ActiveSheet.DrawingObjects(i).Select
      SSH = Selection.ShapeRange.Height
      SHW = Selection.ShapeRange.Width
      If Selection.ShapeRange.Type <> 9 Then '9:½u±ø
         If SSH < 1 Or SHW < 1 Then
            doNerr = doNerr + 1
         End If
      End If
   Next
End With

101
[A1].Select
If doN > 0 Then
   msg = "1.¦@¦³: " & doN & " ­Óª«¥ó(¹Ï¤ù.¤å¦r®Ø...µ¥)" & Chr(10)
   Else
      msg = "¦b¤u§@ªí¤¤¨S¦³ ª«¥ó(¹Ï¤ù.¤å¦r®Ø...)"
End If
If doNerr > 0 Then
   msg = msg & "2.¨ä¤¤¦@¦³: " & doNerr & " ­Ó²Óªøª«¥ó(¹Ï¤ù.¤å¦r®Ø...)Âæb¤u§@ªí¤¤" & _
      Chr(10) & "2.1.«Øij§R°£³o " & doNerr & " ­Ó²Óªøª«¥ó"
   ElseIf doN > 0 Then
      msg = "¨S¦³ ²Óªøª«¥ó(¹Ï¤ù.¤å¦r®Ø...)Âæb¤u§@ªí¤¤"
End If
ck_K = "Àˬd_²Óªøª«¥ó¼Æ¶q"
ck_Q = doNerr
ck_W = msg
If doNerr > 0 Then
   ck_AC = "µ{¦¡¥i¥H¦Û°Ê¥h°£²Óªøª«¥ó"
   Call ³]²M³æ_IÄæ
   Call ·í¦C¤W¦â
   
   Else
      ck_AC = "NA"
End If
End Sub

Andy2483

ÁÂÁ«e½ú­Ì«ü¾É
1.Á|¤@¤Ï¤T,¥Î§Û§ï¤è¦¡®M¥Î
2.¹ïFunction()ÁÙÃjÀ´,¦ý´ú¸ÕÁÙok
3.½Ð«e½ú­Ì¦A«ü¾É

Option Explicit
Sub Àˬd_ª«¥ó¼Æ¶q()
Dim Msg As String
With ActiveSheet
   If .DrawingObjects.Count > 0 Then Msg = "[ªþµù]   ¦³" & .DrawingObjects.Count & "­Ó " & ª«¥ó¼Æ¶q°Æµ{¦¡(.DrawingObjects)
   If Msg <> "" Then Msg = Msg & String(2, vbLf)
   If Msg = "" Then Msg = .Name & " ¨S¦³¥ô¦ó ª«¥ó...."
   MsgBox Msg
End With
End Sub
Function ª«¥ó¼Æ¶q°Æµ{¦¡(draw As Object) As String
Dim e As Object, ª«¥ó As String
For Each e In draw
   ª«¥ó = ª«¥ó & IIf(ª«¥ó <> "", vbLf, "") & e.TopLeftCell.Address & "  " & e.Text
Next
ª«¥ó¼Æ¶q°Æµ{¦¡ = vbLf & ª«¥ó
End Function

¦Û°Ý¦Ûµª¤F

Andy2483

½Ð¦U¦ì«e½ú¦A«ü¾É ÁÂÁÂ
1.¨Ã¤£¬O©Ò¦³DrawingObjects³£¦³¤å¦r,©Ò¥H­×§ï¦A¬ã²ßªºµ{¦¡½X¦p¤U
2.ª«¥ó¼Æ¶q°Æµ{¦¡(.DrawingObjects)¬O«ü³o°Æµ{¦¡­n¦^¶Ç¤@­Ó¦³Ãö©ó²{¤u§@ªí ø¹Ïª«¥óªº­È ªº·N«ä?
3.ª«¥ó¼Æ¶q°Æµ{¦¡(draw As Object) As String ¬O«ü
3.1.¦^¶Çµ¹2.¤@­Ó¦r¦êªº­È,µ¥©ó¬O«Å§i ª«¥ó¼Æ¶q°Æµ{¦¡ ³o´X­Ó¦r¬O°Æµ{¦¡¤]¬O¦r¦êÅܼƪº·N«ä¶Ü?
3.2.³o draw As Object ¬Oµ¥©ó ActiveSheet.DrawingObjects ?
3.3.(.DrawingObjects)¸ò(draw As Object)ÄÝ©Ê­n¬Û¦P,¬Û¤¬©IÀ³?
3.4.(draw As Object) draw¦b¬A©·¸Ì«Å§i¬Oª«¥óÅܼÆ?

Option Explicit
Sub Àˬd_ª«¥ó¼Æ¶q()
Dim msg As String
With ActiveSheet
   If .DrawingObjects.Count > 0 Then msg = "[ª«¥ó]   ¦³" & .DrawingObjects.Count & "­Ó " & ª«¥ó¼Æ¶q°Æµ{¦¡(.DrawingObjects)
   If msg <> "" Then msg = msg & String(2, vbLf)
   If msg = "" Then msg = .Name & " ¨S¦³¥ô¦ó ª«¥ó...."
   MsgBox msg
End With
End Sub
Function ª«¥ó¼Æ¶q°Æµ{¦¡(draw As Object) As String
Dim e As Object, ª«¥ó As String
For Each e In draw
   ª«¥ó = ª«¥ó & IIf(ª«¥ó <> "", vbLf, "") & e.TopLeftCell.Address
Next
ª«¥ó¼Æ¶q°Æµ{¦¡ = vbLf & ª«¥ó
End Function

Andy2483

½Ð¦U¦ì«e½ú¦A«ü¾É ÁÂÁÂ
1.¾Ç·|¹B¥Î Const
2.¾Ç·|¹B¥ÎIIF

ÁÂÁ«e½ú­Ì«ü¾É

Option Explicit    '±j¨î«Å§iÅܼÆ
Const HW = 1 'ª«¥óªº°ª©Î¼e
Sub Àˬd_²Óªøª«¥ó¼Æ¶q()
Dim doN&, msg$, doERRN&, TLC$, drob As Object, SSS&
msg = "¦³²Óªøª«¥óÀx¦s®æ®æ¦ì: "
For Each drob In ActiveSheet.DrawingObjects   '¦¹¤u§@ªí ø¹Ïª«¥ó'¶°¦X'
  With drob  '°w¹ï©Ò¦³Ã¸¹Ïª«¥ó
     If (.Height < HW Or .Width < HW) And .ShapeRange.Type <> 9 Then  '²Å¦X±ø¥ó§PÂ_¦¡ '9:¤ô¥­©Î««ª½½u±ø·|³Q»~§P ©Ò¥H°£¥~
        doERRN = doERRN + 1  '²Ö¥[²Óªøª«¥ó¼Æ¶q
        TLC = .TopLeftCell.Address & "."  '¥ÎTLC ¸Ë¦ì§}¦r¦ê,µ{¦¡¤ñ¸û²¼ä
        msg = msg & IIf(msg Like "*" & TLC & "*", "", TLC) '¦pªG¦hª«¥ó¦b¦P®æ!´N¤£¦A­«½Æ¥X²{®æ¦ì§}
     End If
  End With
Next
msg = msg & " ¦@ " & doERRN & " ­Ó"
If doERRN = 0 Then msg = "¨S¦³²Óªøª«¥ó"
MsgBox msg
End Sub
Sub ²Óªøª«¥ó§R°£()
Dim  drob As Object
For Each drob In ActiveSheet.DrawingObjects   '¦¹¤u§@ªí ø¹Ïª«¥ó'¶°¦X'
  With drob  '°w¹ï©Ò¦³Ã¸¹Ïª«¥ó
    If (.Height < HW Or .Width < HW) And .ShapeRange.Type <> 9 Then  '²Å¦X±ø¥ó§PÂ_¦¡ '9:¤ô¥­©Î««ª½½u±ø·|³Q»~§P ©Ò¥H°£¥~
       .Delete
    End If
  End With
Next
End Sub

Andy2483

½Ð¦U¦ì«e½ú¦A«ü¾É ÁÂÁÂ
1.Function()¬O³o¼Ë¥Î¶Ü?
2.¨â­ÓFunction()¥i¥H¦X¨Ö¦¨¤@­ÓFunction(),¶Ç¨â­Ó­Èµ¹¥Dµ{¦¡¶Ü?

Option Explicit
Const HW = 1 'ª«¥óªº°ª©Î¼e
Sub Àˬd_ª«¥ó¼Æ¶q_1()
Dim msg As String
With ActiveSheet
   If ª«¥ó¼Æ¶q(.DrawingObjects) > 0 Then msg = "[ª«¥ó]   ¦³" & ª«¥ó¼Æ¶q(.DrawingObjects) & "­Ó " & ª«¥ó¼Æ¶q¦ì§}¶°(.DrawingObjects)
   If msg <> "" Then msg = msg & String(2, vbLf)
   If msg = "" Then msg = .Name & " ¨S¦³¥ô¦ó ª«¥ó...."
   MsgBox msg
End With
End Sub

Function ª«¥ó¼Æ¶q¦ì§}¶°(draw As Object) As String 'Integer
Dim e As Object, ª«¥ó As String, TLC$
For Each e In draw
   If (e.Height < HW Or e.Width < HW) And e.ShapeRange.Type <> 9 Then
      TLC = e.TopLeftCell.Address & "."
      ª«¥ó = ª«¥ó & IIf(ª«¥ó Like "*" & TLC & "*", "", TLC)
   End If
Next
ª«¥ó¼Æ¶q¦ì§}¶° = vbLf & ª«¥ó
End Function

Function ª«¥ó¼Æ¶q(draw As Object) As Integer
Dim e As Object, ¼Æ¶q As Integer
For Each e In draw
   If (e.Height < HW Or e.Width < HW) And e.ShapeRange.Type <> 9 Then
      ¼Æ¶q = ¼Æ¶q + 1
   End If
Next
ª«¥ó¼Æ¶q = ¼Æ¶q
End Function