Excel VBA¦p¦óÀˬd_²Óªøª«¥ó¼Æ¶q
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
Excel VBA¦p¦óÀˬd_²Óªøª«¥ó¼Æ¶q
¦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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
ÁÂÁ«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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2020-8-12 09:16 ½s¿è
½Ð¦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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
½Ð¦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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
½Ð¦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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|