Điều khiển quay AutoShape?

Liên hệ QC

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,905
Tôi đang tập tành về VBA, nhờ các bạn hướng dẩn cho code đễ điểu khiển việc quay tự động AutoShape theo thời gian... Trong file này, muốn quay thì phải bấm vào Button... Các bạn giúp tôi 1 code sao cho khi tôi bấm vào nút QUAY thì AutoShape sẽ quay... đúng 1 vòng thì dừng hoặc sau khoảng thời gian định trước thì dừng..
ANH TUẤN

From Mr OKEBAB:
Quay vèo 1 cái hay quay từ từ như kim đồng hồ hả bác ???

Thân!
__________________

Ah... là quay từ từ như đồng hồ vậy! Tôi nhớ ko lầm thì lúc trước Bắp có làm món này rồi... thậm chí là dễ như ăn khoai.. hi.. hi.. Nhưng giờ ko nhớ nó nằm đâu mà tìm nữa...
Bắp giúp giùm với
ANH TUẤN
 

File đính kèm

  • AutoShape_DKQuay.zip
    6.8 KB · Đọc: 1,031
bách tham khảo thêm ở thread này nha:
http://www.giaiphapexcel.com/forum/showthread.php?t=573

anhtuan1066 đã viết:
Soibien ơi, mình đang tập tành thôi mà... code này cũng rất đơn giản, nhưng thú thật là tôi ko biết cách nào biến đổi thành "cái của tôi" dc... Có thể cho tôi 1 code nào đó thực tế hơn ko?
ANH TUẤN
Mục đích của tôi là làm như thế này đây (xem file)... nhưng thay vì bấm "Tới" và "Lui" từng chút 1 thì mình muốn bấm 1 phát thôi... nó sẽ tới lui đến khi bấm "Dừng" hoặc sau 1 khoảng thời gian nào đó
Các bạn giúp với
ANH TUẤN

Bác xem cái này nhé.
 

File đính kèm

  • AutoShape_DKQuay_motvong 28-Oct-07 22-44.Rar
    7.7 KB · Đọc: 854
Upvote 0
Quay trở lại với bài toán QUAY OBJECT.. nói thật tôi cũng chưa thể thấu đáo dc tất cả, kễ cả những bài mà các bạn giới thiệu... Vì code dài quá, chạy thì dc nhưng ko hiểu... Theo các bạn thì trong file của tôi nên thêm cái gì nữa thật đơn giản đễ Object có thể tự động quay dc...
Tôi đang mày mò với VBA nên khó mà theo kịp những file đã hoàn chỉnh! Mong các bạn hiểu cho!
 
Upvote 0
anhtuan1066 đã viết:
Quay trở lại với bài toán QUAY OBJECT.. nói thật tôi cũng chưa thể thấu đáo dc tất cả, kễ cả những bài mà các bạn giới thiệu... Vì code dài quá, chạy thì dc nhưng ko hiểu... Theo các bạn thì trong file của tôi nên thêm cái gì nữa thật đơn giản đễ Object có thể tự động quay dc...
Tôi đang mày mò với VBA nên khó mà theo kịp những file đã hoàn chỉnh! Mong các bạn hiểu cho!

Nếu đơn giản quá thì cũng phải có hàm ontimer để nó chạy mỗi s một ít, còn muốn tới là tới lui là lui thì buộc phải thêm mấy biến + thay button của bác là control.

em up cho bác 2 file, 2 là file đơn giản nhất là làm cho nó quay, bác chẳng làm gì được ngoài việc ngồi ngó nó quay

file 1 thì bác muốn tới thì tới, muốn lui thì lui, ngưng giữa chừng cũng được
 

File đính kèm

  • AutoShape_DKQuay_1 30-Oct-07 14-52.Rar
    13 KB · Đọc: 550
  • AutoShape_DKQuay_2 30-Oct-07 15-07.Rar
    7.8 KB · Đọc: 458
Upvote 0
Quay

Xin góp vui 1 file của tôi về chủ đề này! Tuy nhiên file chưa hoàn thiện, cần thêm nút dừng, reset, ... để animation hoàn thiện hơn.

kích hoạt sheet1 để tự động chạy!
 

File đính kèm

  • Quay1.rar
    713.3 KB · Đọc: 1,076
Upvote 0
File của LearnExcel đẹp quá.. nhưng hơi buồn cười.. Cái xe ô tô chạy 1 hồi thì cái bánh xe chạy trước, xe chạy đàng sau... he... he...
ANH TUẤN
 
Upvote 0
anhtuan1066 đã viết:
File của LearnExcel đẹp quá.. nhưng hơi buồn cười.. Cái xe ô tô chạy 1 hồi thì cái bánh xe chạy trước, xe chạy đàng sau... he... he...
ANH TUẤN

Đúng là mắc cười thật! Nhưng chạy trên máy em thì chạy được 1 lát là bánh xe từ từ rớt ra luôn ... chắc bác LearnExcel quên vặn ốc quá --=0

TP.
 
Upvote 0
@!>>< @!>>< @!>>< ***&&% ***&&% ***&&%
Ha ha ha, để các bác thư giãn chút đi.

Tiện thể làm cái thách đố sao cho xe chạy hết màn hình, nếu lốp có rời ra thì tự động lắp lại rồi quay đầu chạy về.

Thế mới thấy cái anh Excel nhà ta làm đạo diễn hoạt hình cũng khá. Chỉ phải cái tội là cứ quay thì lấy tâm quay là trọng tâm của shape chứ không tùy biến được
 
Upvote 0
Các bạn xem xe chạy thế này được chưa?

He... he... Xe cũa thấy đẹp hơn xe của LearnExcel nhưng mà bánh xe vẫn có cãm giác chưa xiết ốc... Nó đung đưa thế nào ấy... Vẫn hơi.. hơi.. bị buồn cười... ha.. ha...
Phi qua.. rồi.. phi lại... Chắc đang tập lái nhỉ?.. ha.. ha...
-------------------------------------
Ah... còn nữa thầy ơi... Xe nó đang chạy, em dùng chuột tóm cổ nó 1 phát kéo ngược lại thì thấy.. xe đi đường xe.. bánh đi đường bánh... Thế mà nó vẫn cứ phi... Tài thật...
-------------------------------------
Chạy 1 hồi.. tự dưng thấy còn có.. 1 bánh... Ac... Ac....
ANH TUẤN
From Voda:
Xe chạy đung đưa vì bánh nó không được tròn. Cái này nhờ bạn nào khéo tay gia công trở lại. Còn xe đang chạy mà bạn túm...chết thật...mình có cảm giác bạn thích phá đồ chơi của trẻ con. Chắc hồi nhỏ nghịch lắm nhỉ? Hi..hi..:-=--=0:-=

Giờ cũng còn... thích nữa thầy ơi... hi.. hi...
Em đang nghĩ nếu như thay chiếc xe bằng 1 hình người thì có thể làm cho nó bước đi như phim hoạt hình ko nhỉ? Vui thật...
ANH TUẤN
 

File đính kèm

  • Quay2.rar
    713.4 KB · Đọc: 936
Upvote 0
Autoshape

Mình muốn Autoshape quay nhưng khi dừng lại tại 1 điểm nào đó bất kỳ thì ta lấy giá trị tại điểm đó có được không?
 

File đính kèm

  • auto.xls
    13.5 KB · Đọc: 92
Upvote 0
Sau 3 năm "lên núi học đạo", giờ em xin các sư phụ cho em được "xuống núi" bằng chiếc xe do chính tay em "ráp"
Em đã làm như sau:
- Vẽ hình chiếc xe ô tô (hoặc tìm mẩu xe trong Clip Art) rồi đặt tên cho nó là Car
- Vẽ 2 bánh xe, lần lượt đặt tên là Weel1 và Weel2
- Ráp 2 bánh xe vào thân xe
- Vẽ 1 CommandButton lên bảng tính, đặt tên là Cmd
- Click phải vào CommandButton, chọn View Code và chèn code này vào:
PHP:
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
PHP:
Private Sub Cmd_Click()
  Dim Way As Long
  With Sheet1
    Way = .Range("B1")
    .Cmd.Caption = IIf(.Cmd.Caption = "Run", "Stop", "Run")
    Do
      If .Shapes("Car").Left <= .Range("B1").Left Then .Range("B1") = 1
      If .Shapes("Car").Left >= .Range("S1").Left Then .Range("B1") = -1
      If Way <> .Range("B1") Then
        .Shapes("Car").Flip 0
        Way = .Range("B1")
      End If
      .Shapes.Range(Array("Wheel1", "Wheel2")).IncrementRotation 10 * Range("B1")
      .Shapes.Range(Array("Car", "Wheel1", "Wheel2")).IncrementLeft 5 * Range("B1")
      Sleep .Range("A2").Value
      DoEvents
    Loop Until Cmd.Caption = "Run"
  End With
End Sub
Trong đó:
- Cell A2 thể hiện thời gian trể, được điều khiển bằng 1 Scroll Bar
- Cell B1 để chỉ hướng chạy
Xin mời các sư phụ "chấm điểm" và góp ý thêm để em có thể "xuống núi" thành công! Hi... hi...
 

File đính kèm

  • ShapeControl.xls
    34.5 KB · Đọc: 206
Upvote 0
Chiếc xe sử dụng trong file trên có cái may mắn là khoảng cách từ trục bánh trước đến mép trước xe, và khoảng cách giữa trục bánh sau và mép sau xe là gần bằng nhau nên khi xe quay đầu không phải điều chỉnh vị trí bánh xe. :

Car..jpg

Anhtuan xem và cải tiến:

- với 1 cái xe bất kỳ (2 khoảng cách trên không bằng nhau), sẽ phải điều chỉnh cái gì khi quay đầu.
- Với 1 xe có bánh trước và bánh sau có kích thước không bằng nhau (xe công nông chẳng hạn) sẽ phải làm gì khi quay đầu, và có phải điều chỉnh tốc độ quay của 2 bánh xe cho khác nhau không.
 
Lần chỉnh sửa cuối:
Upvote 0
Anh anhtuan1066 làm cái ô tô này vui quá!
Em nhìn thấy cái số 1 ở thân xe nó cũng quay đầu mà mắc cười quá!!!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Anh anhtuan1066 làm cái ô tô này vui quá!
Em nhìn thấy cái số 1 ở thân xe nó cũng quay đầu mà mắc cười quá!!!
Cái số 1 ấy có sẳn trên mẫu xe, nếu cảm thấy chướng mắt, mình xóa nó luôn... Hoặc tốn công hơn: vẽ số 1 khác ráp vào
---------------------------------------------------------------------
Anhtuan xem và cải tiến:
- với 1 cái xe bất kỳ (2 khoảng cách trên không bằng nhau), sẽ phải điều chỉnh cái gì khi quay đầu.
- Với 1 xe có bánh trước và bánh sau có kích thước không bằng nhau (xe công nông chẳng hạn) sẽ phải làm gì khi quay đầu, và có phải điều chỉnh tốc độ quay của 2 bánh xe cho khác nhau không.
Dạ! Em cố tình tìm chiếc xe như thế để dể lập trình. Sau này nếu có nhu cầu với 1 chiếc xe bất kỳ thì hướng đi của em là Group chúng lại, bảo đảm chính xác tuyệt đối
Chỉ mất công là khi Group chúng lại rồi, ta phải xử lý quay bánh xe + dịch chuyển riêng cho từng thành phần trong group (code sẽ phải viết hơi khác 1 chút)
(Cái xe này được điểm trung bình không thầy ơi)
---------------------------------------------------------------------
Nói chung, bước đầu muốn viết code thành công thì ta luôn tìm mọi cách để tạo môi trường thuận lợi nhất (với các điều kiện dể nhất)... Thành công rồi ta mới tính tiếp
Em còn đang nghiên cứu cho xe chạy trên 3 loại địa hình: Phương ngang, lên dốc và xuống dốc... Có điều phải "soạn" lại kiến thức hình học phằng và hình giải tích từ thời phổ thông + 1 số kiến thức khác trong VBA (mà em chưa biết)
Hic... Khó lắm đây!
 
Upvote 0
(Cái xe này được điểm trung bình không thầy ơi)

Nói thật lòng thì đạt điểm gần tối đa rồi. Thử so code với những bài ở trên xem: ngắn gọn, hiệu quả. (Hình như có dùng kỹ xảo đổi Caption của Commandbutton của lão chết tiệt thì phải, khà khà khà).

Còn các yêu cầu cải tiến ở bài tên chẳng qua là chọt cho tổng quát hơn mà thôi, người ngoài đâu biết vụ "cố tình tìm xe cho thuận lợi môi trường".

Có điều phải "soạn" lại kiến thức hình học phằng và hình giải tích từ thời phổ thông + 1 số kiến thức khác trong VBA (mà em chưa biết)

Không đến nỗi khổ công thế đâu:

1. Chỉ group 1 phát ngay trước khi quay đầu, sau khi quay đầu xong thì ungroup ngay.
2. Chỉ dùng kiến thức cơ bản và kiến thức về lượng giác thôi. Thí dụ:

- tốc độ quay 2 bánh xe khác nhau: Là sự tương quan giữa đường kính bánh xe (height và width của wheel1 và wheel2) với tốc độ góc, 1 bài toán tỷ lệ thuận đơn giản.
- khi lên dốc, xuống dốc thì dich chuyển shape theo 2 phương dứng và ngang (thay đổi top và left) theo 1 tỷ lệ với sin và cos của góc tạo bởi đường đi và phương ngang. Một công thức tính cho 3 loại địa hình (select case):

PHP:
Select Case XPosition                        'Một lần dịch chuyển 10 pixel theo phương dịch chuyển'
    Case > [A1].Left And < [H1].Left           'Angle  = +30 (lên dốc)'
        YMove = 10 * 0.5                             'Sin(30)'
        XMove = 10 * 3^ 0.5 / 2                   'Cos(30)'
   Case >= [H10].Left And < [S1].Left         'Angle = 0 (chạy ngang)'
        YMove = 10 
        XMove = 10 
   Case >= [S1].Left And < [AD1].Left             'Angle = -60 (xuống dốc)'
        YMove = - 10 *  3^ 0.5 / 2               'Sin(-60)'
        YMove = 10 *  0.5                           'Cos(-60)'
End Select
        XPosition = XPosition + XMove
        YPosition = YPosition + YMove

Đó là hướng đi xuôi, hướng đi ngược lại tương tự hoặc chỉ cần nhân thêm với 1 biến (1 hoặc -1 theo hướng tới hoặc lui). Biến này hình như có sẵn.
 
Lần chỉnh sửa cuối:
Upvote 0
Không đến nỗi khổ công thế đâu:
1. Chỉ group 1 phát ngay trước khi quay đầu, sau khi quay đầu xong thì ungroup ngay.
2. Chỉ dùng kiến thức cơ bản và kiến thức về lượng giác thôi. Thí dụ:

- tốc độ quay 2 bánh xe khác nhau: Là sự tương quan giữa đường kính bánh xe (height và width của wheel1 và wheel2) với tốc độ góc, 1 bài toán tỷ lệ thuận đơn giản.
- khi lên dốc, xuống dốc thì dich chuyển shape theo 2 phương dứng và ngang (thay đổi top và left) theo 1 tỷ lệ với sin và cos của góc tạo bởi đường đi và phương ngang. Một công thức tính cho 3 loại địa hình (select case):

PHP:
Select Case XPosition 'Một lần dịch chuyển 10 pixel theo phương dịch chuyển'
Case > [A1].Left And < [H1].Left 'Angle = +30 (lên dốc)'
YMove = 10 * 0.5 'Sin(30)'
XMove = 10 * 3^ 0.5 / 2 'Cos(30)'
Case >= [H10].Left And < [S1].Left 'Angle = 0 (chạy ngang)'
YMove = 10 
XMove = 10 
Case >= [S1].Left And < [AD1].Left 'Angle = -60 (xuống dốc)'
YMove = - 10 * 3^ 0.5 / 2 'Sin(-60)'
YMove = 10 * 0.5 'Cos(-60)'
End Select
XPosition = XPosition + XMove
YPosition = YPosition + YMove

Đó là hướng đi xuôi, hướng đi ngược lại tương tự hoặc chỉ cần nhân thêm với 1 biến (1 hoặc -1 theo hướng tới hoặc lui). Biến này hình như có sẵn.

Dạ hổng phải thầy à!
Ý em muốn nói đến trường hợp xe lên dốc và xuống dốc ấy
Đáng tiếc là đối với Object ta lại không có phương thức Intersect (như đối với range) nên phải dùng phương pháp hình học để tính xe khi nào thì bánh xe chạm dốc... Tức là theo kiến thức hình học thì phải tính tọa độ tại điểm mà vòng tròn tiếp xúc với đường thẳng (khi xe vừa lên dốc)... Tại điểm này ta sẽ đổi hướng xe
Còn việc tính lại tốc độ khi lên dốc thì không khó, em "chiếu" vecto tốc độ xuống trục hoành và trục tung để ra được 2 vecto tốc độ theo phương ngang và phương thẳng đứng là xong!
--------------------------------
(Hình như có dùng kỹ xảo đổi Caption của Commandbutton của lão chết tiệt thì phải, khà khà khà).
Món này đúng là "lượm" của sư phụ... Mổi thứ 1 ít, gom lại làm của riêng mình
Hi... hi...
-------------------------
Nói thật lòng thì đạt điểm gần tối đa rồi
Nghe câu này em mừng như bắt được vàng! Cảm ơn sư phụ đã khích lệ
 
Lần chỉnh sửa cuối:
Upvote 0
Tức là theo kiến thức hình học thì phải tính tọa độ tại điểm mà vòng tròn tiếp xúc với đường thẳng (khi xe vừa lên dốc)

Vị trí vòng tròn tiếp xúc với đường thẳng tính bằng:

XWheel1 = Wheel1.Left + (Wheel1.Width / 2)
YWheel1 = Wheel1.Top - (Wheel1.Height / 2)

Xách 2 cái này đi so sánh với vị trí đỉnh dốc và chân dốc

Ẹc ẹc
 
Upvote 0
Ah... em vừa sơ bộ tính ra tọa độ tại điểm tiếp xúc, nhờ sư phụ kiểm tra giúp
Em áp dụng tam giác đồng dạng và Pitago thôi



untitled..JPG
 

File đính kèm

  • Book1.xls
    18.5 KB · Đọc: 74
Upvote 0
à, nhầm tí. Tính theo cách trên thì chạy lố 1 xíu và xe bị chạy âm dưới mặt đường. Khà khà
 
Upvote 0
Web KT
Back
Top Bottom