Xin giúp đỡ về vấn đề co giãn các Shape để hiện thị chiều cao!

gameonly308 · 24/10/18

Em muốn thể hiện chiều cao của nước trong bể, khi thay đổi số liệu chiều cao, thì cột nước ứng với Shape thể hiện chiều cao của nước sẽ thay đổi.
Mong các anh chị hướng dẫn em cách làm với ạ, em xin cảm ơn!

HeSanbi · 25/10/18

gameonly308 đã viết:
Em muốn thể hiện chiều cao của nước trong bể, khi thay đổi số liệu chiều cao, thì cột nước ứng với Shape thể hiện chiều cao của nước sẽ thay đổi.
Mong các anh chị hướng dẫn em cách làm với ạ, em xin cảm ơn!

Dùng cái này nhé bạn, gồm các biến và thông số:
1. sp1 - Shapes A
2. sp2 - Shapes B
3. ar - Shapes Arrow
4. h - [K7]
5. per1 - tỉ lệ chiều cao Shapes A (h*per1)
6. per2 - chiều cao Shape B
7. areaTop - vị trí các Shape dọc
8. areaLeft - vị trí các Shape ngang

Copy code lắng nghe sự kiện thay đổi một select:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", [K7], 20, 300, 50, 50

End Sub

Bỏ vào code worksheet sheet1

Mã:

Sub test_changeShapesHeight()
changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", 2,20 , 300, 50, 50
End Sub
' code dưới copy vào module
    Function changeShapesHeight(sp1 As String, sp2 As String, Optional ar As String, Optional h As Integer, _
                                Optional per1 As Integer = 20, Optional per2 As Integer = 300, _
                                Optional areaTop As Integer = 30, Optional areaLeft As Integer = 20) As Integer
       
        If h < 0 Or h > per2 / per1 Then MsgBox "Data Out": Exit Function
        Dim i

        With ActiveSheet.Shapes.Range(Array(sp2))
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = areaTop
            .Height = per2
        End With
        With ActiveSheet.Shapes.Range(Array(sp1))
            i = .Width
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
        End With
        If ar = vbNullString Then Exit Function
        With ActiveSheet.Shapes.Range(Array(ar))
            .Left = areaLeft + i + 20: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
            .Width = 0
        End With
    End Function

gameonly308 · 25/10/18

minahnh0011 đã viết:

Dùng cái này nhé bạn, gồm các biến và thông số:
1. sp1 - Shapes A
2. sp2 - Shapes B
3. ar - Shapes Arrow
4. h - [K7]
5. per1 - tỉ lệ chiều cao Shapes A (h*per1)
6. per2 - chiều cao Shape B
7. areaTop - vị trí các Shape dọc
8. areaLeft - vị trí các Shape ngang

Copy code lắng nghe sự kiện thay đổi một select:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([K7], Target) Is Nothing Then
        changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", Selection.Value, 20, 300, 50, 50
    End If
End Sub

Bỏ vào code worksheet sheet1

Mã:

Sub test_changeShapesHeight()
changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", 2,20 , 300, 50, 50
End Sub
' code dưới copy vào module
    Function changeShapesHeight(sp1 As String, sp2 As String, Optional ar As String, Optional h As Integer, _
                                Optional per1 As Integer = 20, Optional per2 As Integer = 300, _
                                Optional areaTop As Integer = 30, Optional areaLeft As Integer = 20) As Integer
       
        If h < 0 Or h > per2 / per1 Then MsgBox "Data Out": Exit Function
        Dim i

        With ActiveSheet.Shapes.Range(Array(sp2))
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = areaTop
            .Height = per2
        End With
        With ActiveSheet.Shapes.Range(Array(sp1))
            i = .Width
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
        End With
        If ar = vbNullString Then Exit Function
        With ActiveSheet.Shapes.Range(Array(ar))
            .Left = areaLeft + i + 20: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
            .Width = 0
        End With
    End Function

Ok, để mình test thử xem ạ!

gameonly308 · 25/10/18

minahnh0011 đã viết:

Dùng cái này nhé bạn, gồm các biến và thông số:
1. sp1 - Shapes A
2. sp2 - Shapes B
3. ar - Shapes Arrow
4. h - [K7]
5. per1 - tỉ lệ chiều cao Shapes A (h*per1)
6. per2 - chiều cao Shape B
7. areaTop - vị trí các Shape dọc
8. areaLeft - vị trí các Shape ngang

Copy code lắng nghe sự kiện thay đổi một select:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([K7], Target) Is Nothing Then
        changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", Selection.Value, 20, 300, 50, 50
    End If
End Sub

Bỏ vào code worksheet sheet1

Mã:

Sub test_changeShapesHeight()
changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", 2,20 , 300, 50, 50
End Sub
' code dưới copy vào module
    Function changeShapesHeight(sp1 As String, sp2 As String, Optional ar As String, Optional h As Integer, _
                                Optional per1 As Integer = 20, Optional per2 As Integer = 300, _
                                Optional areaTop As Integer = 30, Optional areaLeft As Integer = 20) As Integer
       
        If h < 0 Or h > per2 / per1 Then MsgBox "Data Out": Exit Function
        Dim i

        With ActiveSheet.Shapes.Range(Array(sp2))
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = areaTop
            .Height = per2
        End With
        With ActiveSheet.Shapes.Range(Array(sp1))
            i = .Width
            .Adjustments.Item(1) = 0.25
            .Left = areaLeft: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
        End With
        If ar = vbNullString Then Exit Function
        With ActiveSheet.Shapes.Range(Array(ar))
            .Left = areaLeft + i + 20: .Top = per2 - h * per1 + areaTop
            .Height = h * per1
            .Width = 0
        End With
    End Function

Cái “can 1” và “can 2” ở đây là gì thế ạ?

HeSanbi · 25/10/18

gameonly308 đã viết:
Cái “can 1” và “can 2” ở đây là gì thế ạ?

Cái tên của shapes đấy . CLick vào shapes nhìn lên Hộp tên sẽ thấy.
Nếu không biết tên shapes của bạn chương trình sẽ biết điều khiển cái shapes nào đây

gameonly308 · 25/10/18

minahnh0011 đã viết:
Cái tên của shapes đấy . CLick vào shapes nhìn lên Hộp tên sẽ thấy.
Nếu không biết tên shapes của bạn chương trình sẽ biết điều khiển cái shapes nào đây

Bạn có thể gửi luôn file excel cho mình được không? Mình vừa đối chiếu vừa nghiên cứu luôn!

Bài đã được tự động gộp: 25/10/18

minahnh0011 đã viết:
Cái tên của shapes đấy . CLick vào shapes nhìn lên Hộp tên sẽ thấy.
Nếu không biết tên shapes của bạn chương trình sẽ biết điều khiển cái shapes nào đây

Mình đã làm như bạn hướng dẫn nhưng không chạy, khi thay đổi chiều cao, các Shape không thay đổi cái gì cả

HeSanbi · 25/10/18

gameonly308 đã viết:
Bạn có thể gửi luôn file excel cho mình được không? Mình vừa đối chiếu vừa nghiên cứu luôn!

Thì cái file của bạn đấy, copy code theo hướng dẫn.
chọn excel - Alt + F11 , thấy sheet bỏ code vô, chuột phải add module bỏ code vô, save file thành xlsm / xlsb

gameonly308 · 25/10/18

minahnh0011 đã viết:
Thì cái file của bạn đấy, copy code theo hướng dẫn.
chọn excel - Alt + F11 , thấy sheet bỏ code vô, chuột phải add module bỏ code vô, save file thành xlsm / xlsb

Đây bạn, không được

HeSanbi · 25/10/18

gameonly308 đã viết:
Đây bạn, không được

changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", Selection.Value, 20, 300, 50, 50
Bạn định cho cột của bạn nhảy khỏi excel sao lại cho thông số 88
20 và 300 là 2 số quyết định tỉ lệ chiều cao của bạn (300 / 20 = 15) bạn thay đổi thì nó thay đổi

gameonly308 · 25/10/18

minahnh0011 đã viết:
changeShapesHeight "can 2", "can 1", "Straight Arrow Connector 4", Selection.Value, 20, 300, 50, 50
Bạn định cho cột của bạn nhảy khỏi excel sao lại cho thông số 88
20 và 300 là 2 số quyết định tỉ lệ chiều cao của bạn (300 / 20 = 15) bạn thay đổi thì nó thay đổi

Cái Shape D không di chuyển và số trong Shape không thay đổi khi chiều cao thay đổi bạn ạ !

HeSanbi · 25/10/18

gameonly308 đã viết:
Cái Shape D không di chuyển và số trong Shape không thay đổi khi chiều cao thay đổi bạn ạ !

Xong nhé

gameonly308 · 25/10/18

minahnh0011 đã viết:
Xong nhé

OK cảm ơn bạn, có gì vướng mắc tiếp mong bạn sẽ hỗ trợ mình thêm nhé!

batman1 · 25/10/18

Nói chung để làm chuẩn, đẹp thì phải mệt nhiều.

Vd. nhập 1, 2 hoặc 14 thì thấy ngồ ngộ thế nào ấy. Nhất là khi nhập 14

HeSanbi · 25/10/18

batman1 đã viết:
Nói chung để làm chuẩn, đẹp thì phải mệt nhiều.

Vd. nhập 1, 2 hoặc 14 thì thấy ngồ ngộ thế nào ấy. Nhất là khi nhập 14

Đưa vào thuật toán tính độ nghiên, tại tính lười biến nặng lắm Bác, mà có tính ra thì chỉ được 60% chính xác dể nhìn, vì co giản Shapes trong excel chỉ ở dạng xem 2D

Xin giúp đỡ về vấn đề co giãn các Shape để hiện thị chiều cao!

gameonly308

Thành viên hoạt động

File đính kèm

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

gameonly308

Thành viên hoạt động

gameonly308

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

gameonly308

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

gameonly308

Thành viên hoạt động

File đính kèm

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

File đính kèm

gameonly308

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

File đính kèm

gameonly308

Thành viên hoạt động

batman1

Thành viên gạo cội

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

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