Mỗi ngày thêm 1 code hay

[lehongduc]

Chào các Bạn,
Để thêm phần phong phú và hữu ích tôi đề nghị chúng ta cùng tham gia vào topic này: "Mỗi ngày thêm 1 code hay" nhằm tập hợp những VBA code hay do các thành viên tự viết hoặc sưu tầm được.
Bài viết xin theo cấu trúc sau:
1. Công dụng: Ghi rõ công dụng của doạn code dùng để làm gì?
2. Nguồn: nếu là tham khảo từ nguồn nào xin ghi rõ trong phần này
3. Code: ghi nội dung code
4. Bình luận: ghi ý kiến bình luận về đoạn code trên, mục đích để làm rõ thêm hoặc nêu những ưu điểm hay hạn chế.

Khi nào chúng ta đã có số vốn kha khá đề nghị "chủ xị" của diễn đàn cho lập thêm 1 tiểu mục chuyên cho nội dung này.

Mong được các Bạn nhiệt tình hưởng ứng.
Lê Hồng Đức
-----------------------------------------------------------------------------------------
Xin tham gia bài đầu tiên.

01. Lấy ngày cuối cùng của tháng:​

1. Công dụng: Lấy ngày cuối cùng của tháng (tháng xác định theo ngày xác định. Chính là MyDate trong Function bên dưới)
2. Nguồn: http://support.microsoft.com/?kbid=210493
3. Code:

'******************************************************
'Declarations Section of Module
'******************************************************
Option Explicit

'******************************************************
'FindEOM Function
'******************************************************
'This function takes a date as an argument and returns the last
'day of the month.
Function FindEOM (MyDate)

Dim NextMonth, EndOfMonth
NextMonth = DateAdd("m", 1, MyDate)
EndOfMonth = NextMonth - DatePart("d", NextMonth)
FindEOM = EndOfMonth

End Function

4. Bình Luận: Bác Bill thật là rườm rà quá thể! Mần ngắn gọn như sau cũng đặng vậy:
DateSerial(Year(Date()), Month(Date()) + 1, 0)
Ta chỉ cần thay Date() là ngày mà ta muốn xác định.

Và nếu ta làm gọn hơn cũng đặng:
DateSerial(NămNào, ThángNào + 1, 0)

 

[dangtuanson]

Ðề: Mỗi ngày thêm 1 code hay

Function Maxday(ngay as date) as byte
Maxday=day(dateserial(year(ngay),month(ngay)+1,0))
end function

 

[phatnq2002]

Ðề: Mỗi ngày thêm 1 code hay

Hoan nghênh "sáng kiến" (đặt trong ngoặc kép với dụng ý tích cực ) của bạn lehongduc.

Mỗi người có thể đóng góp thêm để làm đầy "kho" code của những ai yêu mến lập trình nói cung và yêu mến Access nói riêng.

 

[behattieu]

Ðề: Mỗi ngày thêm 1 code hay

Đúng vậy, ta nên tập hợp các đoạn code và chức năng của nó, nếu kèm theo được sample càng tốt hơn. Cái này em cũng đang làm dưới dạng từ điển tra cứu.
Em nghĩ chúng ta nên phát triển một bộ từ điển tra cứu code (có thể viết bằng VB hoặc access). Khi nào cần ta chỉ việc lôi cái bộ từ điển đó ra tra cứu 1 cái là xong

 

[muontennguoi]

Ðề: Mỗi ngày thêm 1 code hay

Đề nghị khi thêm một đoạn code mới thì đánh số để sau này dễ tìm.

Ví dụ như code số 1 của lehongduc thì đánh số thứ tự 01, đặt tiêu đề, co chữ đậm, tô màu xanh dương.

 

[lehongduc]

Ðề: Mỗi ngày thêm 1 code hay

Chào các Bạn,
Để thêm phần phong phú và hữu ích tôi đề nghị chúng ta cùng tham gia vào topic này: "Mỗi ngày thêm 1 code hay" nhằm tập hợp những VBA code hay do các thành viên tự viết hoặc sưu tầm được.
Bài viết xin theo cấu trúc sau:
1. Công dụng: Ghi rõ công dụng của doạn code dùng để làm gì?
2. Nguồn: nếu là tham khảo từ nguồn nào xin ghi rõ trong phần này
3. Code: ghi nội dung code
4. Bình luận: ghi ý kiến bình luận về đoạn code trên, mục đích để làm rõ thêm hoặc nêu những ưu điểm hay hạn chế.

Khi nào chúng ta đã có số vốn kha khá đề nghị "chủ xị" của diễn đàn cho lập thêm 1 tiểu mục chuyên cho nội dung này.

Mong được các Bạn nhiệt tình hưởng ứng.
Lê Hồng Đức
-----------------------------------------------------------------------------------------
1. Công dụng: Điều khiển MS. Excel từ MS. Access, bao gồm tất cả các tác vụ: tạo bảng tính, nhập, xoá, thay đổi dữ liệu trong các ô bảng tính, định dạng bảng tính, ...

2. Nguồn: http://www.mvps.org/access/modules/mdl0006.htm

3. Code: xin trích nguyên văn tiếng Anh

A sample Sub to demonstrate Excel Automation.
Note: Also pick up the fIsAppRunning function from the API section.

'************ Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Sub sTestXL()
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

objXL.Application.workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkBook

With objActiveWkb
.Worksheets(1).Cells(1, 1) = "Hello World"
strWhat = .Worksheets(1).Cells(1, 1).value
End With

objActiveWkb.Close savechanges:=False

If boolXL Then objXL.Application.Quit

Set objActiveWkb = Nothing: Set objXL = Nothing
MsgBox strWhat
End Sub
'************ Code End **********

4. Bình luận:
Chúng ta có thể ứng dụng để viết 1 thủ tục Export 1 Report ra Excel với định dạng báo biểu giống như Report gốc. Nếu dùng tác vụ Export data của MS. Access sẽ không làm được việc này.

 

[phatnq2002]

Ðề: Mỗi ngày thêm 1 code hay

Chào các Bạn,
Để thêm phần phong phú và hữu ích tôi đề nghị chúng ta cùng tham gia vào topic này: "Mỗi ngày thêm 1 code hay" nhằm tập hợp những VBA code hay do các thành viên tự viết hoặc sưu tầm được.
Bài viết xin theo cấu trúc sau:
1. Công dụng: Ghi rõ công dụng của doạn code dùng để làm gì?
2. Nguồn: nếu là tham khảo từ nguồn nào xin ghi rõ trong phần này
3. Code: ghi nội dung code
4. Bình luận: ghi ý kiến bình luận về đoạn code trên, mục đích để làm rõ thêm hoặc nêu những ưu điểm hay hạn chế.

Khi nào chúng ta đã có số vốn kha khá đề nghị "chủ xị" của diễn đàn cho lập thêm 1 tiểu mục chuyên cho nội dung này.

Mong được các Bạn nhiệt tình hưởng ứng.
Lê Hồng Đức
-----------------------------------------------------------------------------------------
1. Công dụng: Điều khiển MS. Excel từ MS. Access, bao gồm tất cả các tác vụ: tạo bảng tính, nhập, xoá, thay đổi dữ liệu trong các ô bảng tính, định dạng bảng tính, ...

2. Nguồn: http://www.mvps.org/access/modules/mdl0006.htm

3. Code: xin trích nguyên văn tiếng Anh

A sample Sub to demonstrate Excel Automation.
Note: Also pick up the fIsAppRunning function from the API section.

'************ Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Sub sTestXL()
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

objXL.Application.workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkBook

With objActiveWkb
.Worksheets(1).Cells(1, 1) = "Hello World"
strWhat = .Worksheets(1).Cells(1, 1).value
End With

objActiveWkb.Close savechanges:=False

If boolXL Then objXL.Application.Quit

Set objActiveWkb = Nothing: Set objXL = Nothing
MsgBox strWhat
End Sub
'************ Code End **********

4. Bình luận:
Chúng ta có thể ứng dụng để viết 1 thủ tục Export 1 Report ra Excel với định dạng báo biểu giống như Report gốc. Nếu dùng tác vụ Export data của MS. Access sẽ không làm được việc này.

4. Bình luận:
Tôi đồng ý. Nhưng vấn đề là để cho gần giống với report như đã tạo trong Access, chúng ta phải đặt các lệnh định dạng kèm theo dữ liệu được export qua Excel.

Muốn vậy thì anh em cũng cần tham khảo qua Excel VBA một chút, vì một số object, method, properties trong Excel VBA sẽ có khác ít nhiều so với Access VBA.

Một mẹo để phần nào hiểu được cách tham chiếu đến các đối tượng của Excel VBA là các bạn vào Excel, tạo một macro bằng Record New Macro, sau đó thực hiện một số thao tác mà mình muốn. Stop và ALT-F11 để xem tiến trình thao tác được thể hiện qua những câu lệnh của Excel VBA.

 

[minhtrietst]

Ðề: Mỗi ngày thêm 1 code hay

Xin giup vui bang 1 code sau day:

1. Công dụng: xuat 1 report ra excel
2. Nguồn: quen roi
3. Code: tao code nhu sau:

Function XuatExcel()

Dim Tentailieu As String, GetAppDir As String
GetAppDir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir$(CurrentDb.Name)))
Tentailieu = Screen.ActiveReport.Name
DoCmd.OutputTo acOutputReport, Tentailieu, acFormatXLS, GetAppDir & Tentailieu & ".XLS"
MsgBox "Da xuat Bao bieu hien hanh thanh File " & GetAppDir & Tentailieu & ".XLS"

End Function

SAU DO TAO MOT MACRO NHU SAU:

macro name:^{F12}
action: runcode
comment: Export Report dang mo sang Excel
function name: XuatExcel ()

luu macro lai voi ten la Autokeys

HET!!!!!!!!!!!!!!!!!!!!!!!!