GBKEE

¦^´_ 1# skyutm
¸Õ¸Õ¬Ý

¤U¸ü (53.55 KB)

2012-10-5 08:22

GBKEE

¦^´_ 6# skyutm
¬O³o¼Ë¶Ü?

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh As Worksheet, ·Ó¤ù¦ì¸m As Range
   
4.     Set Sh = ActiveSheet
   
5.     Set ·Ó¤ù¦ì¸m = Sh.[d5]
   
6.     With Sh
   
7.         .Pictures.Delete                                    '§R°£¤u§@ªí¥þ³¡¹Ï¤ù(¦pÁÙ¦³¨ä¾l¼Ë¦¡ªº Shape ·|¤@¨Ö§R°£)
   
8.         With .[IV1]
   
9.             .FormulaR1C1 = "§õ¤j" & Chr(10) & "©ú¦L"
   
10.             .Font.Size = 14
    
11.             .Font.ColorIndex = 3
    
12.             .Font.Name = "µØ±d¥j¦LÅé(P)"                    '­×§ï§APC¤Wªº¦rÅé
    
13.             .HorizontalAlignment = xlCenter
    
14.             .VerticalAlignment = xlCenter
    
15.             .WrapText = True
    
16.             .MergeCells = False
    
17.             .Copy
    
18.         End With
    
19.         With .Pictures.Paste
    
20.             .Placement = xlMoveAndSize
    
21.             .PrintObject = True
    
22.             .Top = ·Ó¤ù¦ì¸m.Top                             '¹Ï¤ù:³»ºÝ¦ì¸m
    
23.             .Left = ·Ó¤ù¦ì¸m.Left                           '¹Ï¤ù:¥ªÃä¦ì¸m
    
24.             .ShapeRange.Fill.Visible = msoTrue              '¹Ï¤ù­I´º Åã¥Ü
    
25.            ' .ShapeRange.Fill.ForeColor.SchemeColor = 41    '­I´ºÃC¦â
    
26.              .ShapeRange.Line.Visible = msoTrue             '¹Ï¤ùÃä®Ø Åã¥Ü
    
27.             .ShapeRange.Line.Weight = 0.75                  'Ãä®Ø.«p«×
    
28.           '  .ShapeRange.Line.Visible = msoTrue
    
29.             .ShapeRange.Line.ForeColor.SchemeColor = 10     '¹Ï¤ùÃä®Ø.ÃC¦â
    
30.          '   .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    
31.         End With
    
32.         .[IV1] = ""
    
33.     End With
    
34. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 13# skyutm

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh As Worksheet, M(1 To 2) As String, E As Range
   
4.     Set Sh = ActiveSheet
   
5.     'Set ·Ó¤ù¦ì¸m = Sh.[d5]
   
6.     With ActiveSheet
   
7.         .Pictures.Delete                                    '§R°£¤u§@ªí¥þ³¡¹Ï¤ù(¦pÁÙ¦³¨ä¾l¼Ë¦¡ªº Shape ·|¤@¨Ö§R°£)
   
8.         For Each E In .[a1:a10]                            '*****[a1:a10] ¤w¦³©m¦W*****
   
9.             M(1) = E
   
10.             M(2) = Mid(E, 1, 2) & Chr(10) & Mid(E, 3, IIf(Len(E) < 3, 1, Len(E) - 2)) & "¦L"
    
11.             With E
    
12.             .FormulaR1C1 = M(2)
    
13.             .Font.Size = 14
    
14.             .Font.ColorIndex = 3
    
15.             .Font.Name = "µØ±d¥j¦LÅé(P)"                    '­×§ï§APC¤Wªº¦rÅé
    
16.             .HorizontalAlignment = xlCenter
    
17.             .VerticalAlignment = xlCenter
    
18.             .WrapText = True
    
19.             .EntireRow.AutoFit                              '¦Û°Ê½Õ¾ã¦C°ª
    
20.             .Copy
    
21.         End With
    
22.         With .Pictures.Paste
    
23.             .Placement = xlMoveAndSize
    
24.             .PrintObject = True
    
25.             
    
26.             '*********** ¹Ï¤ù¶K¦b[B1:B10]     *******
    
27.             .Top = E.Offset(, 1).Top                        '¹Ï¤ù:³»ºÝ¦ì¸m
    
28.             .Left = E.Offset(, 1).Left                      '¹Ï¤ù:¥ªÃä¦ì¸m
    
29.             E.Offset(, 1).RowHeight = E.RowHeight           '¹Ï¤ù¶K¦b[B1:B10] ½Õ¾ã ¦C°ª
    
30.             E.Offset(, 1).ColumnWidth = E.ColumnWidth       '¹Ï¤ù¶K¦b[B1:B10] ½Õ¾ã Äæ¼e
    
31.              '*********** ¹Ï¤ù¶K¦b[B1:B10]     *******
    
32.             
    
33.             .ShapeRange.Fill.Visible = msoTrue              '¹Ï¤ù­I´º Åã¥Ü
    
34.            ' .ShapeRange.Fill.ForeColor.SchemeColor = 41    '­I´ºÃC¦â
    
35.              .ShapeRange.Line.Visible = msoTrue             '¹Ï¤ùÃä®Ø Åã¥Ü
    
36.             .ShapeRange.Line.Weight = 0.75                  'Ãä®Ø.«p«×
    
37.           '  .ShapeRange.Line.Visible = msoTrue
    
38.             .ShapeRange.Line.ForeColor.SchemeColor = 10     '¹Ï¤ùÃä®Ø.ÃC¦â
    
39.          '   .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    
40.         End With
    
41.         E.Clear
    
42.         E = M(1)
    
43.         Next
    
44.     End With
    
45. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 15# skyutm

1. With Sheets("¦¨ÁZ³æ")
   
2.     For i = 0 To j
   
3.              .Paste Destination:=.Range("d" & 22 + 26 * i)
   
4.     Next i
   
5.              .Pictures.ShapeRange.IncrementLeft 45
   
6.              .Pictures.ShapeRange.IncrementTop 5
   
7.            '**** ¤]·|¸òµÛ²¾°Ê*****       .Pictures -> Sheets("¦¨ÁZ³æ")ªº©Ò¦³¹Ï¤ù
   
8.     End With

½Æ»s¥N½X

¸Õ¸Õ¬Ý

1. With Sheets("¦¨ÁZ³æ")
   
2.     For i = 0 To j
   
3.              .Paste Destination:=.Range("d" & 22 + 26 * i)
   
4.               a = .Pictures.Count
   
5.              .Pictures(a).ShapeRange.IncrementLeft 45
   
6.              .Pictures(a).ShapeRange.IncrementTop 5
   
7.     Next i
   
8.     End With

½Æ»s¥N½X

GBKEE

¦^´_ 18# skyutm
°ÆÀɦW .xlsx ¬°2003¥H¤Wªºª©¥» ¦s¬°µL¥¨¶°ªº¬¡­¶Ã¯ À³¸Ó¨S¦³§A»¡ªº°ÝÃD

¦p¬O2003ª©¥i¸Õ¸Õ¬Ý  ¦p°õ¦æ¦³¿ù»~ ½Ð¬Ý  http://gb.twbts.com/index.php?topic=751.8

1. Sub macor24()
   
2.     Dim a, b, u, v, r, n As String, xlVbc As Object
   
3.     a = Sheets("°ò¥»³]©w").Range("a6").Value
   
4.     b = Sheets("°ò¥»³]©w").Range("a8").Value
   
5.     u = Sheets("°ò¥»³]©w").Range("j1").Value
   
6.     v = Sheets("°ò¥»³]©w").Range("j2").Value
   
7.     r = "C:\Documents and Settings\Administrator\®à­±\"
   
8.     n = a & "¾Ç¦~«×" & b & "¾Ç´Á" & u & "¦~" & v & "¯Z¦¨ÁZÀÉ"
   
9.     Sheets("¦¨ÁZÀx¦s").Copy
   
10.     Sheets(1).Copy
    
11.     Application.DisplayAlerts = False
    
12.     With ActiveWorkbook
    
13.         For Each xlVbc In .VBProject.VBComponents
    
14.             xlVbc.CodeModule.DeleteLines 1, xlVbc.CodeModule.CountOfLines
    
15.         Next
    
16.         .SaveAs Filename:=r & n & ".xls"
    
17.     End With
    
18.     ThisWorkbook.Close savechanges:=True
    
19. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 20# skyutm
»yªk°õ¦æ¤§«á¡AÁÙ¬O·|¦³»yªk¿ù»~
¬O­þ¤@¦æµ{¦¡½X¿ù»~,¿ù»~­È¬O¦h¤Ö,©Î¬OªþÀɬݬÝ.

GBKEE

¦^´_ 23# skyutm
20# ªºµ{¦¡½X¦³­×§ïªÅ¶¡

1. Option Explicit
   
2. Sub Ex() '½m²ß¸Õ¸Õ¬Ý   ¬¡­¶Ã¯,¤u§@ªí: ¶·¬Ò¨S¤WÂꪺª¬ºA
   
3.     Workbooks(1).Sheets(1).Copy            ' Sheets(1) ½Ð¥ý»s§@VBA¥¨¶°
   
4.     'Workbooks("TEST").Sheets("TEST").Copy   ' Sheets(1) ½Ð¥ý»s§@VBA¥¨¶°
   
5.     With ActiveWorkbook
   
6.         Application.DisplayAlerts = False
   
7.         .SaveAs "d:\µL¥¨¶°.xlsx", FileFormat:=51 ' xlExcel8
   
8.          '**  °ÆÀɦW:xlsx  ¬°µLVBA¥¨¶° ªº¬¡­¶Ã¯
   
9.         Application.DisplayAlerts = False
   
10.     End With
    
11. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 25# skyutm
½Ð°Ý§A°õ¦æµ{¦¡«á¦³±N¦¹ÀÉ®×Ãö³¬,µM«á¦b¥´¶}¬Ý¬Ý,¦¹Àɮר̵M¬O¦³¥¨¶°¦s¦b¶Ü?
¦A¸Õ¸Õ¬Ý

1. Sub Ex() '½m²ß¸Õ¸Õ¬Ý   ¬¡­¶Ã¯,¤u§@ªí: ¶·¬Ò¨S¤WÂꪺª¬ºA
   
2.     Workbooks(1).Sheets(1).Copy            ' Sheets(1) ½Ð¥ý»s§@VBA¥¨¶°
   
3.     'Workbooks("TEST").Sheets("TEST").Copy   ' Sheets(1) ½Ð¥ý»s§@VBA¥¨¶°
   
4.     With ActiveWorkbook
   
5.         Application.DisplayAlerts = False
   
6.         .SaveAs "d:\µL¥¨¶°.xlsx", FileFormat:=51 ' xlExcel8
   
7.          '**  °ÆÀɦW:xlsx  ¬°µLVBA¥¨¶° ªº¬¡­¶Ã¯
   
8.         Application.DisplayAlerts = False
   
9.         .Close
   
10.     End With
    
11.     Workbooks.Open ("d:\µL¥¨¶°.xlsx")
    
12. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 28# skyutm
°õ¦æ2 4# ªºµ{¦¡½X«á ¶·±NÀÉ®×Ãö³¬,µM«á¦A¥´¶}¤~·|µL¥¨¶°

1. Workbooks(1).Sheets(1).Copy        '->½Æ»sSheets(1) ªº¤u§@ªí·|¦b·s¼Wªº¬¡­¶Ã¯      
   
2. With ActiveWorkbook                     '>·s¼Wªº¬¡­¶Ã¯
   
3.         Application.DisplayAlerts = False
   
4.         .SaveAs "d:\µL¥¨¶°.xlsx", FileFormat:=51 ' xlExcel8
   
5.       '**  °ÆÀɦW:xlsx  ¬°µLVBA¥¨¶° ªº¬¡­¶Ã¯
   
6.       '***'¦sÀÉ«á ÁÙ¬O¦³¥¨¶°
   
7.         Application.DisplayAlerts = False
   
8.      .Close            '26#·s¥[ªºµ{¦¡½X  *** Ãö³¬ÀÉ®×
   
9.     End With
   
10.     Workbooks.Open ("d:\µL¥¨¶°.xlsx")   '26#·s¥[ªºµ{¦¡½X  *** ¶}±ÒÀÉ®×

½Æ»s¥N½X

GBKEE

¦^´_ 30# skyutm
¥[¤@¦æOn Error Resume Next¡A³o¼Ë´N¥i¥H¸Ñ¨M¤F¡C¡]¤£ª¾³o¼Ë¦³µL­·ÀI¶Ü¡H¡^
¬O¦³ªº ¦p¦³¿ù»~ªº»yªk©ÎÅܼƮѼg¿ù»~, VBA¬O¤£³B¸Ìªº.
½ÐªþÀɬݬÝ