Tùy chọn

Mỗi ngày một code VBA

Trang chủ
Mỗi ngày một code VBA
Mỗi ngày một code VBA

vba > 08-01-11, 10:12 PM

Em mong các bác cùng em tham gia nhiệt tình luồng này nhé, các bác có gì hay cùng post lên cho anh em cùng được mở rộng tầm mắt nhé

Public Function Mahoa(Data As String, Optional Depth As Integer) As String
Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer
For vChar = 1 To Len(Data)
TempChar = Mid$(Data, vChar, 1)
TempAsc = Asc(TempChar)
If Depth = 0 Then Depth = 40
If Depth > 254 Then Depth = 254

TempAsc = TempAsc + Depth
If TempAsc > 255 Then TempAsc = TempAsc - 255
TempChar = Chr(TempAsc)
NewData = NewData & TempChar
Next vChar
Mahoa = NewData

Giải thích các đối số:
Data: Chuối ký tự cần mã hoá
Depth: Tuỳ chọn độ dài mã hoá là các số nguyên

VD1: Mahoa("vba",8)=> kết quả là ~ji
nhưng mahoa("vba",9) => kết quả lại là kj
Các bác tự nghiên cứu tiếp nhé.

Tất nhiên đã có mã hoá thì phải có giải mã. Em xin khất các bác hôm sau nhé
RE: Mỗi ngày một code VBA

vba > 09-01-11, 08:57 PM

Như đã hẹn, em xin gửi các bác tham khảo code giaima

Public Function GiaiMa(Data As String, Optional Depth As Integer) As String
Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer

For vChar = 1 To Len(Data)
TempChar = Mid$(Data, vChar, 1)
TempAsc = Asc(TempChar)
If Depth = 0 Then Depth = 40
If Depth > 254 Then Depth = 254
TempAsc = TempAsc - Depth
If TempAsc < 0 Then TempAsc = TempAsc + 255
TempChar = Chr(TempAsc)
NewData = NewData & TempChar
Next vChar
GiaiMa = NewData
End Function

Chú ý: VD các bác mã hoá dùng hàm mahoa("vba",9)=~ji
Do đó khi giải mã, các bác phải dùng hàm: giaima("~ji",9) => kết quả là vba
Nếu các bác dùng giaima("~ji",6) thì lại ra 1 kết quả khác đấy
RE: Mỗi ngày một code VBA

vba > 09-01-11, 09:26 PM

Về ứng dụng 2 hàm này các bác có thể sử dụng trong việc quản lý mã hoá mật khẩu trong table User của các bác là hay nhất
RE: Mỗi ngày một code VBA

vba > 10-01-11, 10:10 PM

Hàm tạo thư mục theo đường dẫn

Public Function CreateDir(path As String) As Boolean

Static Start, pos As Integer
Static directory As String
Static result As Boolean
result = True

' initialize the error trap
On Error GoTo errCreation

' if null string why bother....
If path = "" Then Err.Raise vbObjectError + 1

' start will always be null
' the first time through
If Start = Empty Then
Start = 1
Else
Start = pos + 1
End If

' find "\" if the char exists
pos = InStr(Start, path, Chr$(92))

If (pos <> 0) Then
' not at the last directory in the path string...
directory = directory + Mid$(path, Start, pos - Start) + Chr$(92)
If InStr(1, Mid$(path, Start, pos - Start), Chr$(58)) = 0 And Dir(directory, vbDirectory) = "" Then
MkDir Mid$(directory, 1, Len(directory) - 1)
End If
' call itself
result = CreateDir(path)
ElseIf (pos = 0) Then
' the last directory or the only in the path string
directory = directory + Mid$(path, Start, Len(path) - Start + 1)
MkDir Mid$(directory, 1, Len(directory))
directory = ""
End If

' success return true
CreateDir = result

Exit Function

' if it gets here, an exception was thrown
' propogate the error to the calling function
errCreation:
Err.Clear
result = False
CreateDir = result

End Function

VD:
If Dir("C:\vba\vba1")="" then
createdir ("c:\vba\vba1")
endif
=> Hàm đã tạo ra thư mục vba1 nằm trong thư mục vba ở thư mục gốc của ổ đĩa C
RE: Mỗi ngày một code VBA

haquocquan > 11-01-11, 03:54 PM

Cũng có một hàm tạo thư mục theo đường dẫn khác (sử dụng hàm của Access, không phải tự tạo hàm):
Ví dự

Mã:
MkDir("C:\VBA\VBA1")

Kết quả tương tự như trên
RE: Mỗi ngày một code VBA

vba > 11-01-11, 09:12 PM

Bác Haquocquan liệu có nhầm không nhỉ. Hàm Mkdir chỉ tạo được 1 cấp thôi thôi
VD: Mình cần tạo thư mục "D:\vba\vba1\vba2\vba3\vba4\vba5" thì khi dùng hàm Createdir ở trên chỉ cần gọi:
Createdir("D:\vba\vba1\vba2\vba3\vba4\vba5")
Nhưng dùng hàm Mkdir của bác thì phải dùng như sau:

Mrdir ("D:\vba")
Mrdir ("D:\vba\vba1")
Mrdir ("D:\vba\vba1\vba2")
Mrdir ("D:\vba\vba1\vba2\vba3")
Mrdir ("D:\vba\vba1\vba2\vba3\vba4")
Mrdir ("D:\vba\vba1\vba2\vba3\vba4\vba5")

Nếu dùng Mrdir ("D:\vba\vba1\vba2\vba3\vba4\vba5") chương trình sẽ báo lỗi ngay là: Runtime -error 76
Path not found
Bởi vì nó tìm ngay thư mục vba đã không thấy rồi. Nói tóm lại nó chỉ tạo được thư mục từng cấp thôi

Qua VD trên của em, về mỹ quan bác thấy dùng hàm nào hơn rồi đấy
RE: Mỗi ngày một code VBA

vba > 11-01-11, 09:43 PM

4. Hàm tính số ngày làm việc loại trừ đi ngày T7 và CN

Public Function WorkingDays(StartDate As Date, EndDate As Date) As Integer
On Error GoTo Err_WorkingDays
Dim intCount As Integer
StartDate = StartDate + 1
intCount = 0
Do While StartDate <= EndDate

Select Case WeekDay(StartDate)
Case Is = 1, 7
intCount = intCount
Case Is = 2, 3, 4, 5, 6
intCount = intCount + 1
End Select
StartDate = StartDate + 1
Loop
WorkingDays = intCount

Exit_WorkingDays:
Exit Function

Err_WorkingDays:
Select Case Err

Case Else
MsgBox Err.Description
Resume Exit_WorkingDays
End Select
End Function
RE: Mỗi ngày một code VBA

vba > 17-01-11, 10:30 PM

Mấy hôm rồi bận quá, hôm nay mới vào được mong các pro thông cảm nhá
5. Hàm Format các giá trị number, Text, Date trên các control trong Form hoặc Report hoặc câu lệnh SQL, rất tiện lợi
Public Function Cv(Value, Num_Text_or_Date As String) As Variant

'The Num_Text_or_Date parameter accepts:
' N, Num or Number for Boolean,Byte,Integer,Long,Currency,Single,Double
' T, Text or String for Text, Memo
' D or Date for Date/Time
If Not IsNull(Value) Then
Select Case Num_Text_or_Date
Case "N", "Num", "Number"
Cv = Value
Case "T", "Text", "String"
Cv = Chr(34) & Replace(Value, "'", "''") & Chr(34)
Case "D", "Date"
Cv = "#" & Format(Value, "mm/dd/yyyy") & "#"
Case Else
MsgBox "Gia tri nay chua duoc ung dung trong ham nay", vbExclamation
End Select
End If
End Function

VD khi sử dụng:
Dim SQL As String

SQL = "SELECT * FROM tblCustomers WHERE DateField = " & Cv(DateControl, "D")
SQL = SQL & " AND TextField = " & Cv(TextControl, "T")
Debug.Print SQL

Kết quả là:

SELECT * FROM tblCustomers WHERE DateField = #01/01/2008# AND TextField = "vba"

Theo tôi, cái này các bác có thể ứng dụng vào form tìm kiếm dữ liệu mà trong đó có các Option Group để lựa chọn nhiều tiêu chí tìm kiếm và chỉ cần duy nhất 1 textbox, và khi gõ gia trị vào Textbox này thì có thể nhận được kiểu number, text, date...
Bác nào chưa hiểu, Em sẽ gửi Demo lên sau nhé
RE: Mỗi ngày một code VBA

dannynguyen1980 > 17-05-12, 10:54 AM

(17-01-11, 10:30 PM)vba Đã viết: Mấy hôm rồi bận quá, hôm nay mới vào được mong các pro thông cảm nhá
5. Hàm Format các giá trị number, Text, Date trên các control trong Form hoặc Report hoặc câu lệnh SQL, rất tiện lợi
Public Function Cv(Value, Num_Text_or_Date As String) As Variant

'The Num_Text_or_Date parameter accepts:
' N, Num or Number for Boolean,Byte,Integer,Long,Currency,Single,Double
' T, Text or String for Text, Memo
' D or Date for Date/Time
If Not IsNull(Value) Then
Select Case Num_Text_or_Date
Case "N", "Num", "Number"
Cv = Value
Case "T", "Text", "String"
Cv = Chr(34) & Replace(Value, "'", "''") & Chr(34)
Case "D", "Date"
Cv = "#" & Format(Value, "mm/dd/yyyy") & "#"
Case Else
MsgBox "Gia tri nay chua duoc ung dung trong ham nay", vbExclamation
End Select
End If
End Function

VD khi sử dụng:
Dim SQL As String

SQL = "SELECT * FROM tblCustomers WHERE DateField = " & Cv(DateControl, "D")
SQL = SQL & " AND TextField = " & Cv(TextControl, "T")
Debug.Print SQL

Kết quả là:

SELECT * FROM tblCustomers WHERE DateField = #01/01/2008# AND TextField = "vba"

Theo tôi, cái này các bác có thể ứng dụng vào form tìm kiếm dữ liệu mà trong đó có các Option Group để lựa chọn nhiều tiêu chí tìm kiếm và chỉ cần duy nhất 1 textbox, và khi gõ gia trị vào Textbox này thì có thể nhận được kiểu number, text, date...
Bác nào chưa hiểu, Em sẽ gửi Demo lên sau nhé

Cho mình xin file demo nhe bác vba
Cảm ơn bác nhiều.
RE: Mỗi ngày một code VBA

Minh Tiên > 19-05-14, 11:30 AM

(08-01-11, 10:12 PM)vba Đã viết: Em mong các bác cùng em tham gia nhiệt tình luồng này nhé, các bác có gì hay cùng post lên cho anh em cùng được mở rộng tầm mắt nhé

Public Function Mahoa(Data As String, Optional Depth As Integer) As String
Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer
For vChar = 1 To Len(Data)
TempChar = Mid$(Data, vChar, 1)
TempAsc = Asc(TempChar)
If Depth = 0 Then Depth = 40
If Depth > 254 Then Depth = 254

TempAsc = TempAsc + Depth
If TempAsc > 255 Then TempAsc = TempAsc - 255
TempChar = Chr(TempAsc)
NewData = NewData & TempChar
Next vChar
Mahoa = NewData

Giải thích các đối số:
Data: Chuối ký tự cần mã hoá
Depth: Tuỳ chọn độ dài mã hoá là các số nguyên

VD1: Mahoa("vba",8)=> kết quả là ~ji
nhưng mahoa("vba",9) => kết quả lại là kj
Các bác tự nghiên cứu tiếp nhé.

Tất nhiên đã có mã hoá thì phải có giải mã. Em xin khất các bác hôm sau nhé
Chào bạn "VBA" !
Hàm Mã hóa và Giải mã của bật rất hay.
Xong nếu đã Mã hóa theo cách này rồi thì có thể "giải mã được" bằng cách tra dần từ 1-255 vào hàm Giải mã ! Như thế tính bảo mật chưa OK lắm.
Bạn có cách nào mã hóa với bảo mật OK hơn, chia sẽ với diễn đàn nhé !
Cảm ơn bạn nhiều !
Bài trước Bài tiếp

Mỗi ngày một code VBA

Trang chủ

Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA

RE: Mỗi ngày một code VBA