Some sample for VBA

demo

1. Sub Remove_Range()
   
2. '
   
3. ' Remove_Range Macro
   
4. '
   
5. 
   
6. '
   
7.     Application.Goto Reference:="Table_Query_from_SQL_Query"
   
8.     Selection.ListObject.ListColumns(1).Delete
   
9.     Selection.ListObject.ListColumns(1).Delete
   
10.     Selection.ListObject.ListColumns(1).Delete
    
11.     Selection.ListObject.ListColumns(1).Delete
    
12.     Selection.ListObject.ListColumns(1).Delete
    
13.     Selection.ListObject.ListColumns(1).Delete
    
14.     Selection.ListObject.ListColumns(1).Delete
    
15.     Selection.ListObject.ListColumns(1).Delete
    
16.     Selection.ListObject.ListColumns(1).Delete
    
17.     Selection.ListObject.ListColumns(1).Delete
    
18.     Selection.ListObject.ListColumns(1).Delete
    
19.     Selection.ListObject.ListColumns(1).Delete
    
20.     Selection.ListObject.ListColumns(1).Delete
    
21.     Selection.ListObject.ListColumns(1).Delete
    
22.     Range("B3").Select
    
23. End Sub
    
24. Sub SQL_Query_Demo()
    
25. '
    
26. ' Macro2 Macro
    
27. '
    
28. 
    
29. '
    
30.     Sheets.Add After:=Sheets(Sheets.Count)
    
31.     Range("B2").Select
    
32.     With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    
33.         "OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=acorntest;Use Procedure for Prepare=1;Auto T" _
    
34.         , _
    
35.         "ranslate=True;Packet Size=4096;Workstation ID=JZHANG-WIN7;Use Encryption for Data=False;Tag with column collation when possible=" _
    
36.         , "False;Initial Catalog=tmpData"), Destination:=Range("$B$2")).QueryTable
    
37.         .CommandType = xlCmdTable
    
38.         .CommandText = Array("""tmpData"".""dbo"".""branch""")
    
39.         .RowNumbers = False
    
40.         .FillAdjacentFormulas = False
    
41.         .PreserveFormatting = True
    
42.         .RefreshOnFileOpen = False
    
43.         .BackgroundQuery = True
    
44.         .RefreshStyle = xlInsertDeleteCells
    
45.         .SavePassword = False
    
46.         .SaveData = True
    
47.         .AdjustColumnWidth = True
    
48.         .RefreshPeriod = 0
    
49.         .PreserveColumnInfo = True
    
50.         .SourceConnectionFile = _
    
51.         "C:\Users\jzhang\Documents\My Data Sources\acorntest tmpData branch.odc"
    
52.         .ListObject.DisplayName = "Table_acorntest_tmpData_branch"
    
53.         .Refresh BackgroundQuery:=False
    
54.     End With
    
55.     Selection.AutoFilter
    
56.     Selection.ClearFormats
    
57.     ActiveSheet.ListObjects("Table_acorntest_tmpData_branch").TableStyle = ""
    
58.     Selection.ListObject.QueryTable.Delete
    
59. End Sub
    
60. Sub Macro3()
    
61. '
    
62. ' Macro3 Copy data from selected Range
    
63. '
    
64. 
    
65. '
    
66.     Application.Goto Reference:="Customer_Edit_Range"
    
67.     Selection.Copy
    
68.     Sheets("RecordControl").Select
    
69.     Range("A5").Select
    
70.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
71.         :=False, Transpose:=False
    
72.     Range("A5").Select
    
73. End Sub
    
74. Sub Macro4()
    
75. '
    
76. ' Macro4 Name a Range
    
77. '
    
78. 
    
79. '
    
80.     Sheets("RecordControl").Select
    
81.     Application.CutCopyMode = False
    
82.     ActiveWorkbook.Names.Add Name:="TestData", RefersToR1C1:= _
    
83.         "=RecordControl!R5C1:R6C13"
    
84.     Application.Goto Reference:="vDataRangeTL"
    
85.     Application.Goto Reference:="TestData"
    
86. End Sub
    
87. Sub Macro5()
    
88. '
    
89. ' Macro5 Copy, Paste and Rename the range
    
90. '
    
91. 
    
92. '
    
93.     Sheets("DataSource").Select
    
94.     Range("B3:G6").Select
    
95.     Selection.Copy
    
96.     Sheets("RecordControl").Select
    
97.     Range("A5").Select
    
98.     ActiveSheet.Paste
    
99.     Application.CutCopyMode = False
    
100.     ActiveWorkbook.Names.Add Name:="TestData", RefersToR1C1:= _
     
101.         "=RecordControl!R5C1:R8C6"
     
102.     Range("F19").Select
     
103.     Application.Goto Reference:="TestData"
     
104.     Selection.Delete Shift:=xlUp
     
105.     Range("A5").Select
     
106. End Sub
     
107. 
     
108. Sub Macro_copy()
     
109. '
     
110. ' Macro1 Macro
     
111. ' Copy from one sheet in another workfile to another sheet Rename the Tag
     
112. '
     
113. 
     
114. '
     
115.     Windows("Book1").Activate
     
116.     Sheets("Sheet1").Name = "Source"
     
117.     Sheets("Sheet2").Name = "Dest"
     
118.     Application.CutCopyMode = False
     
119.     Sheets("Source").Range("B2").Copy
     
120.     Sheets("Dest").Select
     
121.     ActiveSheet.Paste Destination:=Worksheets("Dest").Range("A2")
     
122.     Sheets("Dest").Columns("A:A").EntireColumn.AutoFit
     
123.     Application.CutCopyMode = False
     
124.     Sheets("Source").Range("C2:N2").Copy
     
125.     Sheets("Dest").Paste Destination:=Sheets("Dest").Range("B2")
     
126.     'Sheets("Dest").Range("B2").Select
     
127.     'ActiveSheet.Paste
     
128.     Columns("B:B").EntireColumn.AutoFit
     
129.     Columns("C:C").EntireColumn.AutoFit
     
130.     Columns("D:D").EntireColumn.AutoFit
     
131.     Columns("M:M").EntireColumn.AutoFit
     
132.     Columns("L:L").EntireColumn.AutoFit
     
133.     Columns("K:K").EntireColumn.AutoFit
     
134.     Columns("J:J").EntireColumn.AutoFit
     
135.     Columns("I:I").EntireColumn.AutoFit
     
136.     Application.CutCopyMode = False
     
137.     Sheets("Source").Range("B3:B4").Copy
     
138.     'Application.CutCopyMode = False
     
139.     'Selection.Copy
     
140.     'Sheets("Dest").Range("A3").Select
     
141.     Sheets("Dest").Paste Destination:=Sheets("Dest").Range("A3")
     
142.     'Sheets("Source").Select
     
143.     'Range("C3:N4").Select
     
144.     Application.CutCopyMode = False
     
145.     Sheets("Source").Range("C3:N4").Copy
     
146.     Sheets("Dest").Range("B3").Select
     
147.     Sheets("Dest").Paste Destination:=Sheets("Dest").Range("B3")
     
148.     Dim myList, myCell, i
     
149.     i = 1
     
150.     Sheets("Dest").Range("A3").Select
     
151.     'myList = Sheets("Dest").Range(Selection.End(xlToLeft), Selection.End(xlToRight)).Select
     
152.     myList = Sheets("Dest").Range(Selection.End(xlUp), Selection.End(xlDown)).Select
     
153.     For Each myCell In Selection
     
154.         'myCell.Value = "i"
     
155.         Windows("PERSONAL").Activate
     
156.         
     
157.         Sheets("Sheet1").Cells(i, 1).Value = myCell.Value
     
158.         Windows("Book1").Activate
     
159.         i = i + 1
     
160.     Next
     
161.     Sheets("Source").Select
     
162. End Sub
     
163. 
     
164. Sub Macro_Item_Process()
     
165. '
     
166. ' Micro to update report according to another reference list
     
167. ' Copy data from one sheet in another another sheet and loop li to the end
     
168. '
     
169. 
     
170. '
     
171.     Dim i, j, op_Code, s_Cust, s_Cls, s_Alloy, s_Form, s_Date, s_Rep, s_Inv, s_Ton, s_Moh
     
172.     Windows("NV_Customer_Specific_Items").Activate
     
173.     Dim myList, myCell
     
174.     i = 1
     
175.     Sheets("Inv").Select
     
176.     Sheets("Inv").Range("B2").Select
     
177.     'myList = Sheets("Dest").Range(Selection.End(xlToLeft), Selection.End(xlToRight)).Select
     
178.     myList = Sheets("Inv").Range("B2", Selection.End(xlDown)).Select
     
179.     For Each myCell In Selection
     
180.         s_Cust = myCell.Value: s_Cls = myCell.Offset(0, 1).Value: s_Alloy = myCell.Offset(0, 2).Value
     
181.         s_Form = myCell.Offset(0, 3).Value
     
182.         s_Date = myCell.Offset(0, 4).Value: s_Inv = myCell.Offset(0, 5).Value
     
183.         s_Ton = myCell.Offset(0, 6).Value
     
184.         Sheets("Detail").Select
     
185.         j = 2
     
186.         Do
     
187.            
     
188.            j = j + 1
     
189.         Loop While (j < 356) And (Sheets("Detail").Cells(j, 3).Value <> s_Cust Or _
     
190.         Sheets("Detail").Cells(j, 5).Value <> s_Cls Or Sheets("Detail").Cells(j, 6).Value <> s_Alloy Or _
     
191.         Sheets("Detail").Cells(j, 7).Value <> s_Form)
     
192.         If j > 355 Then
     
193.            op_Code = MsgBox("Customer: " + s_Cust + vbCrLf + "Class:   " + s_Cls + vbCrLf + _
     
194.            "Alloy:    " + s_Alloy + vbCrLf + "Form:     " + s_Form + vbCrLf + "Continue ?", vbYesNo, "No Exist!")
     
195.            If op_Code = vbNo Then
     
196.               GoTo EndPro
     
197.            End If
     
198.         Else
     
199.            MsgBox "Line:" & j & " found the item: " & Sheets("Detail").Cells(j, 3).Value & " |" & _
     
200.                   Sheets("Detail").Cells(j, 5).Value & "|Alloy:" & Sheets("Detail").Cells(j, 6).Value & "|Form:" & _
     
201.                   Sheets("Detail").Cells(j, 7).Value & vbCrLf & _
     
202.                   "Data into:" & vbCrLf & _
     
203.                   "|" & s_Cust & "|" & s_Cls & "|" & s_Alloy & "|" & s_Form & _
     
204.                   "|" & s_Date & "|" & s_Inv & "|" & s_Ton
     
205.         End If
     
206.         
     
207.         'Sheets("Sheet1").Cells(i, 1).Value = myCell.Value
     
208.         Sheets("Inv").Select
     
209.         i = i + 1
     
210.     Next
     
211.     'Sheets("Source").Select
     
212.     'Windows("PERSONAL").Activate
     
213. EndPro:
     
214. End Sub
     
215. 
     

复制代码

demo

1. Sub Macro_copy_all()
   
2. '
   
3. ' Macro_copy_all Macro
   
4. '
   
5. 
   
6. '
   
7.     Range("A3:E8").Select
   
8.     Selection.Copy
   
9.     Range("A26").Select
   
10.     ActiveSheet.Paste
    
11. End Sub
    
12. Sub Macro_Chart2()
    
13. '
    
14. ' Macro2 Macro: Apply 3 groups data to two horizen axies.
    
15. '
    
16. 
    
17. '
    
18.     Range("E4").Select
    
19.     ActiveCell.FormulaR1C1 = "=R4C[-2]"
    
20.     Range("E4").Select
    
21.     ActiveCell.FormulaR1C1 = "=SUM(R4C[-2]:R7C[-2])/4"
    
22.     Selection.AutoFill Destination:=Range("E4:E7"), Type:=xlFillDefault
    
23.     Range("E4:E7").Select
    
24.     Range("A3:E7").Select
    
25.     ActiveSheet.Shapes.AddChart.Select
    
26.     ActiveChart.ChartType = xlColumnClustered
    
27.     ActiveChart.SetSourceData Source:=Range("Sum!$A$3:$E$7")
    
28.     ActiveChart.PlotArea.Select
    
29.     ActiveChart.Axes(xlValue).MajorGridlines.Select
    
30.     ActiveChart.ChartArea.Select
    
31.     ActiveChart.SeriesCollection(1).Select
    
32.     ActiveChart.SetSourceData
    
33.     ActiveChart.SeriesCollection(4).Select
    
34.     ActiveChart.SeriesCollection(4).ChartType = xlLine
    
35.     ActiveChart.PlotArea.Select
    
36.     ActiveChart.Axes(xlValue).MajorGridlines.Select
    
37.     ActiveChart.Legend.Select
    
38.     ActiveChart.SeriesCollection(1).Select
    
39.     ActiveChart.SeriesCollection(1).AxisGroup = 2
    
40.     ActiveSheet.ChartObjects("Chart 1").Activate
    
41.     ActiveChart.SeriesCollection(1).Select
    
42.     ActiveChart.PlotArea.Select
    
43.     ActiveChart.SeriesCollection(1).Select
    
44.     ActiveChart.SeriesCollection(1).Points(1).Select
    
45.     ActiveChart.SeriesCollection(2).Select
    
46.     ActiveChart.ChartGroups(1).GapWidth = 217
    
47.     ActiveChart.ChartGroups(1).GapWidth = 101
    
48.     ActiveChart.ChartGroups(1).GapWidth = 58
    
49.     ActiveChart.ChartGroups(1).GapWidth = 46
    
50.     ActiveChart.ChartGroups(1).Overlap = -41
    
51.     ActiveChart.ChartGroups(1).Overlap = -54
    
52.     ActiveChart.ChartGroups(1).Overlap = 22
    
53.     ActiveChart.ChartGroups(1).Overlap = -14
    
54.     ActiveChart.ChartGroups(1).Overlap = -43
    
55.     ActiveChart.ChartGroups(1).Overlap = -62
    
56.     ActiveChart.ChartGroups(1).Overlap = -75
    
57.     ActiveChart.PlotArea.Select
    
58.     ActiveChart.SeriesCollection(1).Select
    
59.     ActiveChart.SeriesCollection(3).Select
    
60.     ActiveChart.SeriesCollection(3).AxisGroup = 2
    
61.     ActiveSheet.ChartObjects("Chart 1").Activate
    
62.     ActiveChart.SeriesCollection(3).Select
    
63.     With Selection.Format.Fill
    
64.         .Visible = msoTrue
    
65.         .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    
66.         .ForeColor.TintAndShade = 0
    
67.         .ForeColor.Brightness = 0
    
68.         .BackColor.ObjectThemeColor = msoThemeColorBackground1
    
69.         .BackColor.TintAndShade = 0
    
70.         .BackColor.Brightness = 0
    
71.         .Patterned msoPattern5Percent
    
72.     End With
    
73.     With Selection.Format.Fill
    
74.         .Visible = msoTrue
    
75.         .Patterned msoPattern60Percent
    
76.     End With
    
77.     With Selection.Format.Fill
    
78.         .Visible = msoTrue
    
79.         .Patterned msoPattern60Percent
    
80.     End With
    
81.     With Selection.Format.Fill
    
82.         .Visible = msoTrue
    
83.         .ForeColor.ObjectThemeColor = msoThemeColorAccent1
    
84.         .ForeColor.TintAndShade = 0
    
85.         .ForeColor.Brightness = -0.25
    
86.         .BackColor.ObjectThemeColor = msoThemeColorBackground1
    
87.         .BackColor.TintAndShade = 0
    
88.         .BackColor.Brightness = 0
    
89.         .Patterned msoPattern60Percent
    
90.     End With
    
91.     ActiveChart.ChartGroups(2).Overlap = -47
    
92.     ActiveChart.ChartGroups(2).Overlap = -69
    
93.     ActiveChart.ChartGroups(2).Overlap = -80
    
94.     ActiveChart.ChartGroups(2).GapWidth = 22
    
95.     ActiveChart.ChartGroups(2).GapWidth = 73
    
96.     ActiveChart.ChartGroups(2).GapWidth = 79
    
97.     ActiveChart.ChartGroups(2).GapWidth = 113
    
98.     ActiveChart.ChartGroups(2).GapWidth = 119
    
99.     ActiveChart.ChartGroups(2).GapWidth = 151
    
100.     ActiveChart.SeriesCollection(1).Select
     
101.     ActiveChart.ChartGroups(2).GapWidth = 117
     
102.     ActiveChart.ChartGroups(2).GapWidth = 73
     
103.     ActiveChart.ChartGroups(2).GapWidth = 41
     
104.     ActiveChart.ChartGroups(2).GapWidth = 25
     
105.     ActiveChart.ChartGroups(2).Overlap = -89
     
106.     ActiveChart.ChartGroups(2).Overlap = -100
     
107.     ActiveChart.ChartGroups(2).Overlap = -86
     
108.     ActiveChart.ChartGroups(2).Overlap = -100
     
109.     ActiveChart.ChartGroups(2).GapWidth = 11
     
110.     ActiveChart.ChartGroups(2).GapWidth = 51
     
111.     ActiveChart.SeriesCollection(2).Select
     
112.     ActiveChart.ChartGroups(1).GapWidth = 132
     
113.     ActiveChart.ChartGroups(1).GapWidth = 158
     
114.     ActiveChart.ChartGroups(1).GapWidth = 172
     
115.     ActiveChart.ChartGroups(1).GapWidth = 180
     
116.     ActiveChart.ChartGroups(1).GapWidth = 172
     
117.     ActiveChart.ChartGroups(1).Overlap = -61
     
118.     ActiveChart.ChartGroups(1).Overlap = -24
     
119.     ActiveChart.ChartGroups(1).Overlap = -95
     
120.     ActiveChart.ChartGroups(1).Overlap = -100
     
121.     ActiveChart.ChartGroups(1).Overlap = 0
     
122.     ActiveChart.ChartGroups(1).GapWidth = 166
     
123.     ActiveChart.ChartGroups(1).GapWidth = 152
     
124.     ActiveChart.ChartGroups(1).GapWidth = 140
     
125.     ActiveChart.ChartGroups(1).GapWidth = 160
     
126.     Range("H28").Select
     
127. End Sub
     
128. 
     
129. Sub Macro_Chart()
     
130. '
     
131. ' Macro_Chart Macro
     
132. ' Thi sis to show to to create a Chart from an area
     
133. '
     
134. 
     
135. '
     
136.     Range("A3:D7").Select
     
137.     ActiveSheet.Shapes.AddChart.Select
     
138.     ActiveChart.ChartType = xlColumnClustered
     
139.     ActiveChart.SetSourceData Source:=Range("Sum!$A$3:$D$7")
     
140.     ActiveChart.SeriesCollection(2).Select
     
141.     ActiveChart.SeriesCollection(2).AxisGroup = 2
     
142.     ActiveSheet.ChartObjects("Chart 4").Activate
     
143.     ActiveChart.SeriesCollection(2).Select
     
144.     ActiveChart.ChartGroups(2).GapWidth = 98
     
145.     ActiveChart.ChartGroups(2).GapWidth = 174
     
146.     ActiveChart.ChartGroups(2).GapWidth = 241
     
147.     ActiveChart.ChartGroups(2).GapWidth = 268
     
148.     ActiveChart.ChartGroups(2).GapWidth = 286
     
149.     ActiveChart.ChartGroups(2).GapWidth = 334
     
150.     ActiveChart.ChartGroups(2).Overlap = -32
     
151.     ActiveChart.ChartGroups(2).Overlap = 43
     
152.     ActiveChart.ChartGroups(2).Overlap = -15
     
153.     With Selection.Format.Fill
     
154.         .Visible = msoTrue
     
155.         .ForeColor.RGB = RGB(0, 0, 0)
     
156.         .BackColor.ObjectThemeColor = msoThemeColorBackground1
     
157.         .BackColor.TintAndShade = 0
     
158.         .BackColor.Brightness = 0
     
159.         .Patterned msoPattern5Percent
     
160.     End With
     
161.     With Selection.Format.Fill
     
162.         .Visible = msoTrue
     
163.         .Patterned msoPatternNarrowHorizontal
     
164.     End With
     
165.     With Selection.Format.Fill
     
166.         .Visible = msoTrue
     
167.         .Patterned msoPatternNarrowHorizontal
     
168.     End With
     
169.     With Selection.Format.Fill
     
170.         .Visible = msoTrue
     
171.         .Patterned msoPatternDarkUpwardDiagonal
     
172.     End With
     
173.     With Selection.Format.Fill
     
174.         .Visible = msoTrue
     
175.         .Patterned msoPatternDarkUpwardDiagonal
     
176.     End With
     
177.     With Selection.Format.Fill
     
178.         .Visible = msoTrue
     
179.         .ForeColor.ObjectThemeColor = msoThemeColorAccent2
     
180.         .ForeColor.TintAndShade = 0
     
181.         .ForeColor.Brightness = -0.25
     
182.         .BackColor.ObjectThemeColor = msoThemeColorBackground1
     
183.         .BackColor.TintAndShade = 0
     
184.         .BackColor.Brightness = 0
     
185.         .Patterned msoPatternDarkUpwardDiagonal
     
186.     End With
     
187.     With Selection.Format.Fill
     
188.         .Visible = msoTrue
     
189.         .ForeColor.ObjectThemeColor = msoThemeColorAccent2
     
190.         .ForeColor.TintAndShade = 0
     
191.         .ForeColor.Brightness = -0.25
     
192.         .BackColor.ObjectThemeColor = msoThemeColorAccent6
     
193.         .BackColor.TintAndShade = 0
     
194.         .BackColor.Brightness = 0.6000000238
     
195.         .Patterned msoPatternDarkUpwardDiagonal
     
196.     End With
     
197.     With Selection.Format.Fill
     
198.         .Visible = msoTrue
     
199.         .ForeColor.ObjectThemeColor = msoThemeColorAccent5
     
200.         .ForeColor.TintAndShade = 0
     
201.         .ForeColor.Brightness = 0.400000006
     
202.         .BackColor.ObjectThemeColor = msoThemeColorAccent6
     
203.         .BackColor.TintAndShade = 0
     
204.         .BackColor.Brightness = 0.6000000238
     
205.         .Patterned msoPatternDarkUpwardDiagonal
     
206.     End With
     
207.     With Selection.Format.Fill
     
208.         .Visible = msoTrue
     
209.         .ForeColor.ObjectThemeColor = msoThemeColorAccent5
     
210.         .ForeColor.TintAndShade = 0
     
211.         .ForeColor.Brightness = 0.400000006
     
212.         .BackColor.ObjectThemeColor = msoThemeColorAccent6
     
213.         .BackColor.TintAndShade = 0
     
214.         .BackColor.Brightness = 0
     
215.         .Patterned msoPatternDarkUpwardDiagonal
     
216.     End With
     
217.     ActiveChart.PlotArea.Select
     
218.     Range("E3").Select
     
219.     ActiveCell.FormulaR1C1 = "Average"
     
220.     Range("E4").Select
     
221. End Sub
     
222. 
     

复制代码