Chữ wordart chạy trên trang excell

[minhhangg]

Rất mong các anh giúp dùm em cho chữ chạy trên trang excell

 

[ndu96081631]

Rất mong các anh giúp dùm em cho chữ chạy trên trang excell

Cũng khá đơn giản thôi! Vẽ 1 CommandButton rồi chèn code này vào:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CommandButton1_Click()
  With CommandButton1
    .Caption = IIf(.Caption = "Start", "Stop", "Start")
    Do
      Sheet1.Shapes("WordArt 1").IncrementRotation 10
      Sleep 20
      DoEvents
    Loop Until .Caption = "Start"
  End With
End Sub

Tạm chạy vậy thôi chứ code này chưa phải là tối ưu

 

[minhhangg]

Cũng khá đơn giản thôi! Vẽ 1 CommandButton rồi chèn code này vào:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CommandButton1_Click()
  With CommandButton1
    .Caption = IIf(.Caption = "Start", "Stop", "Start")
    Do
      Sheet1.Shapes("WordArt 1").IncrementRotation 10
      Sleep 20
      DoEvents
    Loop Until .Caption = "Start"
  End With
End Sub

Tạm chạy vậy thôi chứ code này chưa phải là tối ưu

Cảm ơn, anh nhiều, nhưng ý em là khi mở trang excell này lên thì chữ đó tự chạy luôn anh àh. Vậy anh có thể giúp dùm em thêm lần nữa được chứ, thank you

 

[minhhangg]

Em tìm trên diễn đàn code của ndu và em xl có chỉnh sửa lại nhưng thời gian chữ chạy rất nhanh. Vậy em xin nhờ các anh gán cho em thêm thời gian chạy liên tục dùm. cảm ơn

Option Explicit
Private Declare Sub Sleep Lib "kerne123" (ByVal dwMilliseconds As Long)
Private Sub workbook_open()
Dim Text As String
Text = Range("A6").Value
Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
Range("A6") = Text
Sheet1.Shapes("WordArt1").IncrementRotation (3)
End Sub

 

[ndu96081631]

Em tìm trên diễn đàn code của ndu và em xl có chỉnh sửa lại nhưng thời gian chữ chạy rất nhanh. Vậy em xin nhờ các anh gán cho em thêm thời gian chạy liên tục dùm. cảm ơn

Option Explicit
Private Declare Sub Sleep Lib "kerne123" (ByVal dwMilliseconds As Long)
Private Sub workbook_open()
Dim Text As String
Text = Range("A6").Value
Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
Range("A6") = Text
Sheet1.Shapes("WordArt1").IncrementRotation (3)
End Sub

Bạn khai báo hàm Sleep ở trên sao không xài vào code? Nó không Delay nên chạy "mút tầm" là phải rồi
Ít ra thì code cũng phải vầy:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Workbook_Open()
  Dim Text As String
  Do
    Text = Range("A6").Value
    Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
    Range("A6") = Text
    Sheet1.Shapes("WordArt 1").IncrementRotation 3
    Sleep 100
    DoEvents
  Loop Until Sheet1.Range("A1") = 1
  Sheet1.Shapes("WordArt 1").Rotation = 0
End Sub

Với code này, nếu mở file là WordArt tự quay. Khi bạn muốn dừng lại, chỉ cần gõ số 1 vào cell A1
--------------------
Nói chung code này chỉ để... chơi chứ chẳng được tích sự gì

 

[minhhangg]

Sao nó bị lỗi vậy hé anh.

 

[ndu96081631]

Sao nó bị lỗi vậy hé anh.

Hic... Trong code ghi là WordArt 1 (có khoảng trắng)... còn thực tế trên sheet, cái hình ấy có tên là WordArt1 ---> Khác tên nên nó không tìm thấy và báo lỗi là phải rồi còn gì

 

[minhhangg]

Dạ cho em hỏi, dựa vào đâu mà biết được tên Wordart1, Wordart2,Wordart3..... và Wordart 1,Wordart 2,Wordart 3...vậy anh. Cảm ơn anh nhiều

 

[ndu96081631]

Dạ cho em hỏi, dựa vào đâu mà biết được tên Wordart1, Wordart2,Wordart3..... và Wordart 1,Wordart 2,Wordart 3...vậy anh. Cảm ơn anh nhiều

Bất cứ 1 đối tượng nào đều có 1 cái tên. Tên ấy thể hiện ở hộp NameBox



Tên này có thể sửa theo ý mình
------------------------------
Tôi xin nói thêm về cái sự "tào lao" của code dạng này. Đó là tuy nhìn thì bắt mắt nhưng cũng chỉ để nhìn, cuối cùng với file Excel này ta chẳng làm được gì cả. Khi code chạy, thậm chí bạn không có cách nào để format cho cell (như chữ đậm, nghiêng, tô màu...)
Đối với dạng điều khiển chuyển động thì code tối ưu nhất phải đạt được 2 yêu cầu:
- Chuyển động chính xác
- Ta vẫn có thể làm được những công việc khác khi đối tương đang chuyển động
Lấy 1 ví dụ: Hãy xem tôi làm cái đồng hồ tại topic này:
http://www.giaiphapexcel.com/forum/...ng-hồ)-theo-chu-kỳ-1-giây&p=281099#post281099
Đồng hồ vẫn chạy và việc ta, ta cứ làm, chẳng hề bị ảnh hưởng

 

[minhhangg]

Cảm ơn anh, anh hướng dẫn rất thông hiểu.

 

[minhhangg]

Cho em hỏi thêm, em có câu lệnh này đặt ở thisworkbook
Private Sub Workbook_Close(Cancel As Boolean)
If ThisWorkbook.Saved = True Then
Exit Sub
Vậy thêm đoạn code này vào thisworkbook nữa thì code này không chạy được
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Workbook_Open()
Dim Text As String
Do
Text = Range("A6").Value
Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
Range("A6") = Text
Sheet5.Shapes("WordArt 14").IncrementRotation 3
Sleep 100
DoEvents
Loop Until Sheet1.Range("A1") = 1
Sheet5.Shapes("WordArt 14").Rotation = 0
End Sub
Vậy có cách nào thực hiện được 2 đoạn code trên không vậy các anh. cảm ơn

 

[ndu96081631]

Tôi tặng bạn code khác tối ưu hơn
Hãy xem file đính kèm này sẽ thấy rằng lúc code chạy bạn vẫn có thể nhập liệu hoặc làm bất cứ công việc gì bạn thích
Code như sau:
1> Trong Module:

Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Sub StartTimer()
  StopTimer
  SetTimer Application.hWnd, 1, 100, AddressOf TimeProc
End Sub

Sub StopTimer()
  KillTimer Application.hWnd, 1
End Sub

Private Function TimeProc()
  Dim Text As String
  On Error Resume Next
  With Sheet1
    Text = .Range("A6").Value
    Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
    .Range("A6") = Text
    .Shapes("WordArt1").IncrementRotation 2
    .Range("A3") = Now
  End With
End Function

Sub Auto_Open()
  StartTimer
  Sheet1.CommandButton1.Caption = "Stop"
End Sub

Sub Auto_Close()
  StopTimer
  Sheet1.CommandButton1.Caption = "Start"
End Sub

2> Code trong sheet1

Private Sub CommandButton1_Click()
  With Sheet1.CommandButton1
    Run IIf(.Caption = "Start", "StartTimer", "StopTimer")
    .Caption = IIf(.Caption = "Start", "Stop", "Start")
  End With
End Sub

Code phức tạp hơn 1 chút nhưng bù lại nó chạy rất mượt mà
Lưu ý: Tốc độ quét code phụ thuộc vào dòng SetTimer Application.hWnd, 1, 100, AddressOf TimeProc ---> Số màu đỏ càng nhỏ thì chạy càng nhanh

 

[minhhangg]

Cảm ơn anh nhiều, cho em hỏi, làm sao khi mở file lên thì vừa hiện form đăng nhập và form đăng nhập này thoát đi thì tiếp tục tự động chữ chạy được. File gữi kèm chữ không tự động chạy mà phải nhấp vào nút. Xin anh chị giúp dùm. Cảm phiền minhthien321 vì mượn file anh làm vd.

 

[ndu96081631]

Cảm ơn anh nhiều, cho em hỏi, làm sao khi mở file lên thì vừa hiện form đăng nhập và form đăng nhập này thoát đi thì tiếp tục tự động chữ chạy được. File gữi kèm chữ không tự động chạy mà phải nhấp vào nút. Xin anh chị giúp dùm. Cảm phiền minhthien321 vì mượn file anh làm vd.

Code của bạn mở form bằng đoạn code UserForm1.Show và code này đặt trong sự kiện Workbook_Open
Bạn xóa code trong Workbook đi, cho đoạn UserForm1.Show vào sub Autpen là được

Sub Auto_Open()
  StartTimer
  Sheet2.CommandButton1.Caption = "Stop"
  UserForm1.Show
End Sub