Lịch âm trên form không hoàn toàn hoạt động (1 người xem)

CEO76 · 29/11/12

Xin chào,
Tôi muốn tạo một form với lịch âm thể hiện trên form đó. Tôi có thể trình bày lịch sau khi khởi động form, nhưng khi tôi navigate lịch âm qua thanh sử dụng ở phần phía trên từ tháng này qua tháng khác hoặc qua năm khác, tôi không thể thể hiện lịch tháng hoặc năm mà tôi muốn xem.
Xin các bạn xem qua file đính kèm và giúp tôi.
Cảm ơn nhiều
CEO76

siwtom · 29/11/12

CEO76 đã viết:
Xin chào,
Tôi muốn tạo một form với lịch âm thể hiện trên form đó. Tôi có thể trình bày lịch sau khi khởi động form, nhưng khi tôi navigate lịch âm qua thanh sử dụng ở phần phía trên từ tháng này qua tháng khác hoặc qua năm khác, tôi không thể thể hiện lịch tháng hoặc năm mà tôi muốn xem.
Xin các bạn xem qua file đính kèm và giúp tôi.
Cảm ơn nhiều
CEO76

Thực ra cái code như bạn có là để đặt trên trang web trên mạng.
Bạn đặt trên máy của mình nên hơi bị khó.
Thôi thì cứ "cố", nếu chẳng may các thao tác là chuyên nghiệp thì càng tốt, còn nếu là thủ công thì đành vậy. Miễn "máy chạy" là mừng rồi.
Cái document đầu tiên là do bạn tạo ra nên bạn tự quyết định định dạng được. Khi bạn nhấn vào ">", ">>" thì từ lúc đó mọi document đều do server (script) trên mạng tạo ra nên ta không thể (?) quyết định được định dạng và kích thước theo ý muốn.
Bạn sửa lại kích thước cho khít với lịch trên mạng
--------------
Trong code dưới đây những chỗ do tôi thêm vào thì có mầu xanh, chỗ tôi sửa lại thì có mầu đỏ.
À mà hình như trên GPE có code lịch âm dương mà. Bạn không biết hay bạn muốn làm theo kiểu của mình?
---------------------

Mã:

[COLOR=#0000ff]Private Const READYSTATE_COMPLETE = 4
[/COLOR]
Private Sub UserForm_Initialize()
Dim str1, str2, str3 As String
Dim lngIndex As Long
Dim credit As Variant
Dim formwith, formheight As Single
Dim intUnit As Integer
Dim strTemp As String
[COLOR=#0000ff]Dim body As Object, text As String, html As String[/COLOR]

strTemp = "<html><head><script type=""text/javascript"" language=""JavaScript"" src=""[URL]http://www.informatik.uni-leipzig.de/~duc/amlich/JavaScript/amlich-hnd.js[/URL]"">" _
& "</script></head>" _
& "<script language=""JavaScript"">" _
& "setOutputSize(""big"");" _
& "document.writeln(printSelectedMonth());" _
& "</script>" _
& "<body BGCOLOR=""101C44"" TEXT=""#FFFFFF"" topmargin=""0"" leftmargin=""14""></body></html>"
intUnit = FreeFile
Open [COLOR=#ff0000]"f:\MySecretDocument.htm"[/COLOR] For Output As intUnit
Print #intUnit, strTemp
Close intUnit
Me.WebBrowser1.Navigate2 [COLOR=#ff0000]"f:\MySecretDocument.htm"
[/COLOR]Me.WebBrowser1.Visible = True
With Me
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With

[COLOR=#0000ff]Do Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

html = "<html><head><SCRIPT language=JavaScript type=text/javascript src=""[/COLOR][URL="http://www.informatik.uni-leipzig.de/~duc/amlich/JavaScript/amlich-hnd.js""></SCRIPT"][COLOR=#0000ff]http://www.informatik.uni-leipzig.de/~duc/amlich/JavaScript/amlich-hnd.js""></SCRIPT[/COLOR][/URL][COLOR=#0000ff]>" & _
"<STYLE type=text/css><!-- .tennam {text-align:center; font-size:150%; line-height:120%; font-weight:bold; color:#000000; background-color: #CCCCCC}.thang {font-size: 17pt; padding:1; line-height:100%; font-family:Tahoma,Verdana,Arial; table-layout:fixed}.tenthang {text-align:center; font-size:125%; line-height:100%; font-weight:bold; color:#330033; background-color: #CCFFCC}.navi-l {text-align:center; font-size:75%; line-height:100%; " & _
"font-family:Verdana,Times New Roman,Arial; font-weight:bold; color:red; background-color: #CCFFCC}.navi-r {text-align:center; font-size:75%; line-height:100%; font-family:Verdana,Arial,Times New Roman; font-weight:bold; color:#330033; background-color: #CCFFCC}.ngaytuan {width:14%; text-align:center; font-size:125%; line-height:100%; color:#330033; background-color: #FFFFCC}.ngaythang {background-color:#FDFDF0}.homnay " & _
"{background-color:#FFF000}.tet {background-color:#FFCC99}.am {text-align:right;font-size:75%;line-height:100%;color:blue}.am2 {text-align:right;font-size:75%;line-height:100%;color:#004080}.t2t6 {text-align:left;font-size:125%;color:black}.t7 {text-align:left;font-size:125%;line-height:100%;color:green}.cn {text-align:left;font-size:125%;line-height:100%;color:red}--></STYLE></head><body>"

[/COLOR][COLOR=#0000ff]Set body = Me.WebBrowser1.document.body
text = body.innerhtml
Set body = Nothing
text = Replace(text, "/f:/MySecretDocument.htm", "[URL]http://www.informatik.uni-leipzig.de/~duc/amlich/PHP/index.php[/URL]", , , vbTextCompare)
html = html & text & "</body></html>"
Kill "f:\MySecretDocument.htm"
Open "f:\MySecretDocument.htm" For Output As intUnit
Print #intUnit, html
Close intUnit
Me.WebBrowser1.Navigate2 "f:\MySecretDocument.htm"

[/COLOR]End Sub

Private Sub UserForm_Terminate()
Kill [COLOR=#ff0000]"f:\MySecretDocument.htm"[/COLOR]
End Sub

CEO76 · 30/11/12

Cám ơn Siwtom đã sửa lại code của tôi. Function replace là điểm làm nên sự khác biệt. tôi cũng sửa lại một số đoạn code để form có thể hiển thị bất cứ khi nào nó được kích hoạt cũng như thay đổi kích thước của form cho phù hợp với lịch

Một lần nữa xin cám ơn Switom.

-=========Trong Module ===============

Option Explicit
Public counter As Integer
Public filename, reverse_slash As String
Sub Button2_Click()
Call reserveme
Calendar_2.Show
End Sub
Sub reserveme()
Dim i, j As Integer
filename = ThisWorkbook.Path & Application.PathSeparator & "MySecretDocument.htm"
reverse_slash = Replace(filename, "\", "/", 1)
reverse_slash = "/" & reverse_slash
End Sub

-===========Trong Form==============
Option Explicit
Private Const READYSTATE_COMPLETE = 4
'amlich.js
Private Sub UserForm_Initialize()
Dim str1, str2, str3 As String
Dim x, y As Single
Dim lngIndex As Long
Dim credit As Variant
Dim formwith, formheight As Single
Dim intUnit As Integer
Dim strTemp As String
Dim body, element As Object, Text As String, html As String
strTemp = "<html><head><script type=""text/javascript"" language=""JavaScript"" src=""http://www.informatik.uni-leipzig.de/~duc/amlich/JavaScript/amlich-hnd.js"">" _
& "</script></head>" _
& "<script language=""JavaScript"">" _
& "setOutputSize(""big"");" _
& "document.writeln(printSelectedMonth());" _
& "</script>" _
& "<body BGCOLOR=""101C44"" TEXT=""#FFFFFF"" topmargin=""0"" leftmargin=""14""></body></html>"
intUnit = FreeFile
Open filename For Output As intUnit
Print #intUnit, strTemp
Close intUnit
Me.WebBrowser1.Navigate2 filename
Me.WebBrowser1.Visible = True
With Me
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With

Do Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

html = "<html><head><SCRIPT language=JavaScript type=text/javascript src=""http://www.informatik.uni-leipzig.de/~duc/amlich/JavaScript/amlich-hnd.js""></SCRIPT>" & _
"<STYLE type=text/css></STYLE></head><body>"

Set element = Me.WebBrowser1.document.body
Text = element.innerhtml
Text = Replace(Text, reverse_slash, "http://www.informatik.uni-leipzig.de/~duc/amlich/PHP/index.php", , , vbTextCompare)
html = html & Text & "</body></html>"

Kill filename

Open filename For Output As intUnit
Print #intUnit, html
Close intUnit
Me.WebBrowser1.Navigate2 filename
x = element.offsetWidth * 0.75
y = element.offsetHeight * 0.75
Do Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Me.WebBrowser1.Width = x
Me.WebBrowser1.Height = y
Me.Height = y
Me.Width = x
counter = 3
End Sub
Private Sub UserForm_Terminate()
Kill filename
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Dim x, y As Single
x = 336
y = 438
If counter <= 2 Then Exit Sub
Me.WebBrowser1.Width = x
Me.WebBrowser1.Height = y
Me.Height = 458.25
Me.Width = 339
End Sub

Hoàng Trọng Nghĩa · 30/11/12

CEO76 đã viết:
Cám ơn Siwtom đã sửa lại code của tôi. Function replace là điểm làm nên sự khác biệt. tôi cũng sửa lại một số đoạn code để form có thể hiển thị bất cứ khi nào nó được kích hoạt cũng như thay đổi kích thước của form cho phù hợp với lịch

Một lần nữa xin cám ơn Switom.

Lịch dạng này liên kết với một trang web vì vậy nó sẽ không hoạt động được nếu không có internet. Vã lại khi tôi thử dùng code của bạn vừa sửa lại thì có một lỗi khi chọn tháng kế tiếp nó không hoạt động.

Bạn cũng có thể tham khảo form lịch, dù bất cứ ở đâu, có Net hay không có Net vẫn hoạt động tốt:

http://www.giaiphapexcel.com/forum/...n-ích-CALENDAR-tuyệt-đẹp!&p=455338#post455338

Lịch âm trên form không hoàn toàn hoạt động (1 người xem)

Người dùng đang xem chủ đề này

CEO76

Thành viên mới

siwtom

Thành viên gắn bó

File đính kèm

CEO76

Thành viên mới

Hoàng Trọng Nghĩa

Chuyên gia GPE

File đính kèm

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian