Skip to content

Commit 1d3f166

Browse files
ZadigoZadigo
committed
First commit
1 parent a5532fc commit 1d3f166

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

54 files changed

+2558
-0
lines changed

‎Access - VBA Objects.vb

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
'
2+
' Use this anipuate obects
3+
' in your Access atabase
4+
' Peneenue (2018)
5+
'
6+
Sub manipulating_Objects()
7+
' The obect is opene with its generic nae
8+
DoCmd.OpenForm "Form1", acNormal, , , acFormAdd, acHidden
9+
10+
Dim current_ObjectName As String
11+
current_ObjectName = CurrentObjectName
12+
13+
Dim f As form
14+
Set f = Forms(current_ObjectName)
15+
16+
'
17+
' Do something
18+
'
19+
20+
DoCmd.Close acForm, "Form1", acSaveNo
21+
End Sub

‎Access VBA - Controls-1.vb

+64
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
Sub create_NewButton()
2+
'Set parameter
3+
Dim btn As Control
4+
5+
'Open form in hidden mode
6+
DoCmd.OpenForm "Google", acDesign, , , acFormEdit, acHidden
7+
8+
On Error Resume Next
9+
10+
'Create button
11+
Set btn = CreateControl("Google", acCommandButton, acDetail)
12+
13+
'Move
14+
k.Move 2500, 2500, 1500, 700
15+
16+
'Get control name
17+
this_name = k.Name
18+
19+
'Add caption
20+
Forms("Google").Controls(this_name).Caption = "Google"
21+
22+
'Close form
23+
DoCmd.Close acForm, "Google", acSaveYes
24+
End Sub
25+
26+
Sub create_NewButtons()
27+
'Set array
28+
Dim btn(0 To 1) As Control
29+
'Form & control
30+
Dim o As Form
31+
Dim f As Control
32+
Dim leftMove As Long
33+
leftMove = 2000
34+
35+
'Open form hidden
36+
DoCmd.OpenForm "Google", acDesign, , , acFormEdit, acHidden
37+
38+
Set o = Forms("Google")
39+
40+
For i = 0 To 1
41+
'Create buttons
42+
Set btn(i) = CreateControl("Google", acCommandButton, acDetail)
43+
44+
'Set object to control
45+
Set f = Forms("Google").Controls(i)
46+
'Move controls
47+
f.Move 1000, leftMove
48+
49+
'When control is index 1, put x name and caption
50+
If i = 0 Then
51+
f.Name = "Email_Button"
52+
f.Caption = "Email"
53+
Else
54+
f.Name = "Validate_Button"
55+
f.Caption = "Validate"
56+
End If
57+
58+
'Move below
59+
leftMove = leftMove + 1000
60+
Next i
61+
62+
'Close form
63+
DoCmd.Close acForm, "Google", acSaveYes
64+
End Sub

‎Access VBA - Forms - 2.vb

+32
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
Sub create_NewForm()
2+
'Set parameters
3+
Dim j As Form
4+
Set j = CreateForm
5+
'Get current form name
6+
y = Application.CurrentObjectName
7+
'Set variable to object
8+
Set j = Forms(y)
9+
'
10+
' Error handling
11+
'
12+
On Error Resume Next
13+
'Set recordsource to table...
14+
j.RecordSource = "Facebook"
15+
'Close form
16+
DoCmd.Close acForm, "Form2", acSaveYes
17+
'Rename form
18+
DoCmd.Rename "Google", acForm, y
19+
End Sub
20+
21+
Sub manipulate_Form()
22+
'Open form
23+
DoCmd.OpenForm "Form1", acDesign, , , acFormEdit, acHidden
24+
'Get form name
25+
w = Forms![Form1].Command0.Name
26+
'Close form
27+
DoCmd.Close acForm, "Form1", acSaveNo
28+
End Sub
29+
30+
' Apply a filter to forms
31+
' DoCmd.ApplyFilter , "Filiere = 'Bac'"
32+
' DoCmd.ApplyFilter , "Filiere = 'Bac' AND Niveau = 'Master'"

‎Access VBA - Objects general - 3.vb

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
Sub manipulating_Objects()
2+
DoCmd.OpenForm "Form1", acNormal, , , acFormAdd, acHidden
3+
4+
Dim current_ObjectName As String
5+
current_ObjectName = CurrentObjectName
6+
7+
Dim f As form
8+
Set f = Forms(current_ObjectName)
9+
10+
'
11+
' To something
12+
'
13+
14+
DoCmd.Close acForm, "Form1", acSaveNo
15+
End Sub

‎Access VBA - Queries.vb

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
'
2+
' Use this sub to create a query
3+
' John PM (2017)
4+
'
5+
'
6+
Sub create_Query()
7+
Dim qdf As QueryDef
8+
Set qdf = CurrentDb.CreateQueryDef("query1", "SELECT * FROM Table")
9+
10+
On Error Resume Next
11+
12+
DoCmd.OpenQuery "query1", acViewDesign, acEdit
13+
DoCmd.Save acQuery, "query1"
14+
DoCmd.Close acQuery, "query1"
15+
DoCmd.rename "new_name", acQuery, "query1"
16+
17+
Set qdf = Nothing
18+
End Sub
19+
20+
'
21+
' Use this sub to change the source of a query
22+
' John PM (2017)
23+
'
24+
'
25+
Sub manipulate_Query()
26+
Dim query_to_change As QueryDef
27+
Set query_to_change = CurrentDb.QueryDefs("query_name")
28+
29+
query_to_change.SQL = "SELECT * FROM Table ORDER BY ID Asc"
30+
query_to_change.SQL = "SELECT Field1, Field2 FROM Table ORDER BY ID Asc"
31+
query_to_change.SQL = "SELECT Field1, Field2 FROM Table WHERE Field LIKE Fashion"
32+
query_to_change.SQL = "SELECT Field1, Field2 FROM Table WHERE Field LIKE '" & something & "'"
33+
End Sub
34+
35+
' "SELECT Field1, Field2 FROM Table WHERE Field1 = 'Fashion'"

‎Access VBA - Recordset.vb

+57
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
https://msdn.microsoft.com/en-us/library/office/ff821396.aspx
2+
3+
Sub finding_Record()
4+
'
5+
' Opening a record set and findind a record
6+
'
7+
Dim db As DAO.Database
8+
Dim rs As Recordset
9+
10+
Set db = CurrentDb
11+
Set rs = db.OpenRecordset("Tournaments", dbOpenSnapshot)
12+
13+
rs.FindFirst "[TourCode] LIKE 'TOR'"
14+
MsgBox rs(2).Value, vbInformation, "Value"
15+
16+
Set db = Nothing
17+
Set rs = Nothing
18+
End Sub
19+
20+
Sub filter_RecordSet()
21+
'
22+
' Opening a record set and finding a record
23+
'
24+
Dim db As DAO.Database
25+
Dim rs As Recordset
26+
27+
Set db = CurrentDb
28+
Set rs = db.OpenRecordset("SELECT * " & _
29+
"FROM Tournaments " & _
30+
"WHERE TourCode = 'TKY'")
31+
'Set rs = db.OpenRecordset("SELECT * FROM Tournaments " & _
32+
' "WHERE TourCode = 'TKY' AND/OR/NOT ... ''")
33+
'Set rs = db.OpenRecordset("SELECT * " & _
34+
' "FROM Tournaments " & _
35+
' "WHERE TourCode = 'TKY' ORDER BY ... DESC/ASC ")
36+
37+
'TO DO
38+
39+
Set db = Nothing
40+
Set rs = Nothing
41+
End Sub
42+
43+
Sub printing_Elements()
44+
'
45+
' Prints everything from a recordset
46+
'
47+
Dim db As DAO.Database
48+
Set db = CurrentDb
49+
50+
Dim rs As Recordset
51+
Set rs = db.OpenRecordset("Google")
52+
53+
Do While Not rs.EOF
54+
Debug.Print rs("ID") & " - " & rs("Cible1")
55+
rs.MoveNext
56+
Loop
57+
End Sub

‎Access VBA - SQL Creating tables2.vb

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
Sub create_Table()
2+
'
3+
' Example creating a table with SQL
4+
'
5+
DoCmd.RunSQL "CREATE TABLE Kendall (" & _
6+
"HerName varchar (255), " & _
7+
"HerSurname varchar(255), " & _
8+
"HerAge int"
9+
")"
10+
End Sub
11+
12+
Sub modify_Table()
13+
On Error Resume Next
14+
DoCmd.RunSQL "ALTER TABLE Kendall " & _
15+
"ADD COLUMN Address varchar(255)"
16+
End Sub
17+
18+
Sub modify_Table()
19+
DoCmd.RunSQL "UPDATE Google SET Test = '1' WHERE Nom = 'Julie'"
20+
End Sub

‎Access VBA - Search.vb

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
Public Sub search_DB_Static()
2+
' Element to search
3+
q = Text3.Value
4+
' Search record number
5+
search = DLookup("[CustID]", "Customer", "[CustName]='" & q & "'")
6+
' Goto record
7+
DoCmd.GoToRecord , "Form1", acGoTo, search
8+
' Box blank
9+
Text3.Value = ""
10+
' Set focus
11+
CustName.SetFocus
12+
End Sub
13+
14+
' WILDCARDS
15+
' search = DLookup("[CustID]", "Customer", "[CustName]='*" & q & "*'")

‎Access VBA - Tables.vb

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
Sub manipulating_Tables()
2+
On Error Resume Next
3+
'INSERT values
4+
DoCmd.RunSQL "INSERT INTO Facebook(OK, Field1) VALUES ('5', 'Kendall')"
5+
'UPDATE field
6+
DoCmd.RunSQL "UPDATE Facebook SET Field1 = 'Kendall' WHERE ID = 1"
7+
'ALTER TABLE
8+
DoCmd.runSQL "ALTER TABLE X "
9+
End Sub
10+
11+
Sub edit_Table()
12+
Dim d As DAO.Database
13+
Dim t As TableDef
14+
Dim r As DAO.Recordset
15+
16+
Set d = CurrentDb
17+
Set t = d.TableDefs("...")
18+
Set r = t.OpenRecordset(, dbOpenSnapshot)
19+
20+
r.Edit
21+
r(...).Value = "..."
22+
r.Update
23+
24+
Set d = Nothing
25+
Set t = Nothing
26+
End Sub
27+
28+
'When field exists, create random number and put to name "Address"
29+
If Err.Number = 3380 Then
30+
DoCmd.RunSQL "ALTER TABLE Kendall " & _
31+
"ADD COLUMN Address" & Int((25 - 10 + 1) * Rnd + 10) & " varchar(255)" & _
32+
")"
33+
34+
End If
35+
36+
Tables
37+
1. "CREATE TABLE x (...[datatype])"
38+
2. "INSERT INTO x (...) VALUES (... [datatype])"
39+
3. "ALTER TABLE x ADD x [datatype]"
40+
4. "ALTER TABLE x DROP x"
41+
5. "UPDATE x SET x = '...'"
42+
6. "UPDATE x SET x = '...' WHERE x = '...' AND x = '...'"
43+
7. "UPDATE x SET x = '...' WHERE x = '...' OR x = '...'"
44+
8. "UPDATE TABLE x ALTER COLUMN x [datatype]"
45+
9. "CREATE TABLE x (...[datatype] NOT NULL UNIQUE)"
46+
10. "CREATE TABLE x (...[datatype] NOT NULL PRIMARY KEY)"
47+
11. ??? Foreign Key
48+
49+
Queries
50+
1. Create query - "SELECT x FROM x / SELECT x, y FROM x, y"
51+
2. "SELECT x, y.something FROM x INNER JOIN y ON x.something = y.something"
52+
3. "SELECT x FROM x ORDER BY x"
53+
4. Recordset openRecordSet(sql) / openRecordSet(...)
54+
5. .FINDFIRST, FINDLAST etc. "[fieldname] > x"
55+
6. Record Count
56+
7. Fields
57+
58+
DLookup
59+
DLookup("[field]", "table", "[something]=x")
60+
61+
Filter Forms
62+
1. .filter "[field]=x" / .filterOn = true/false
63+
64+
"SELECT CustID, CustName, Product.ProductName " & _
65+
"FROM Customer " & _
66+
"INNER JOIN Product ON Customer.CustID = Product.CustomerID"

‎Calculate winning streaks.vb

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
'Calculate winning streaks
2+
Sub google()
3+
Dim r As Range
4+
Set r = Range("B2:E5")
5+
6+
a = r.Count
7+
t = 0
8+
o = 0
9+
For i = 0 To a
10+
p = r(i)
11+
If r(i) = "W" Then
12+
t = t + 1
13+
If t > o Then
14+
o = t
15+
End If
16+
Else
17+
t = 0
18+
End If
19+
Next i
20+
MsgBox "Longest winning streak: " & o
21+
End Sub

‎Changing Data in Ranges.vb

+32
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
Sub quickly_Change_Data_inRange()
2+
Dim googleCar As Range
3+
Set googleCar = Range("B2").CurrentRegion
4+
5+
For Each Tesla In googleCar
6+
Tesla.Value = 20
7+
Next
8+
End Sub
9+
10+
Sub change_Data_inColumn()
11+
Dim googleCar As Range
12+
Set googleCar = Range("B2").CurrentRegion
13+
14+
For Each Tesla In googleCar.Columns(1)
15+
Tesla.Value = 15
16+
Next
17+
End Sub
18+
19+
'Instead of For...Each just :
20+
'googleCar.Value = ...
21+
22+
Sub change_specific_Data_inRange()
23+
Dim googleCar As Range
24+
Set googleCar = Range("B2").CurrentRegion
25+
26+
For Each Tesla In googleCar
27+
If Tesla = 5 Then
28+
googleCar.Value = 10
29+
End If
30+
Next
31+
End Sub
32+

0 commit comments

Comments
 (0)