Shapes - Shapes Line bằng VBA (4 người xem)

[A Đặng]

Xin chào các Thầy, các Anh Chị trong GPE.
em có đọc qua một số bài viết về Shapes line trong diễn đàn. nhưng vẫn chưa đủ kiến thức để giải quyết vấn đề.
do vậy em có vấn đề đặt ra được lưu trong file đính kèm, mong các thầy, anh chị trong GPE hỗ trợ giùm.
Xin cám ơn !

 

[PacificPR]

Xin chào các Thầy, các Anh Chị trong GPE.
em có đọc qua một số bài viết về Shapes line trong diễn đàn. nhưng vẫn chưa đủ kiến thức để giải quyết vấn đề.
do vậy em có vấn đề đặt ra được lưu trong file đính kèm, mong các thầy, anh chị trong GPE hỗ trợ giùm.
Xin cám ơn !

Bạn thử Code này xem

Sub Addshapetocell()
    Dim ws As Worksheet, s As Shape, eRng As Range
    Dim BeginX As Double, BeginY As Double, EndX As Double, EndY As Double
    Dim Er As Long, Ec As Long
Set ws = ActiveSheet
Set eRng = ws.Range("B11")
Application.ScreenUpdating = False
For Each s In ws.Shapes
    If Not (s.Type = msoOLEControlObject Or s.Type = msoFormControl) Then s.Delete
Next s
With ws
    Er = .Range("D65535").End(3).Row:    Ec = eRng.Row - 1
    For j = 2 To 7
        BeginX = .Range(Cells(Er, 1), .Cells(Er, j)).Width
        BeginY = .Range(Cells(1, j), .Cells(Er, j)).Height
        EndX = .Range(.Cells(Ec, 1), .Cells(Ec, j - 1)).Width
        EndY = .Range(.Cells(1, j - 1), .Cells(Ec, j - 1)).Height
        Set s = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)
        s.Name = "S_" & j
        ActiveSheet.Shapes.Range(Array(s.Name)).Select
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
        End With
    Next j
End With
Set s = Nothing
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[A Đặng]

Bạn thử Code này xem

Sub Addshapetocell()
    Dim ws As Worksheet, s As Shape, eRng As Range
    Dim BeginX As Double, BeginY As Double, EndX As Double, EndY As Double
    Dim Er As Long, Ec As Long
Set ws = ActiveSheet
Set eRng = ws.Range("B11")
Application.ScreenUpdating = False
For Each s In ws.Shapes
    If Not (s.Type = msoOLEControlObject Or s.Type = msoFormControl) Then s.Delete
Next s
With ws
    Er = .Range("D65535").End(3).Row:    Ec = eRng.Row - 1
    For j = 2 To 7
        BeginX = .Range(Cells(Er, 1), .Cells(Er, j)).Width
        BeginY = .Range(Cells(1, j), .Cells(Er, j)).Height
        EndX = .Range(.Cells(Ec, 1), .Cells(Ec, j - 1)).Width
        EndY = .Range(.Cells(1, j - 1), .Cells(Ec, j - 1)).Height
        Set s = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)
        s.Name = "S_" & j
        ActiveSheet.Shapes.Range(Array(s.Name)).Select
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
        End With
    Next j
End With
Set s = Nothing
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Xin cám ơn PacificPR rất nhiều. code hoạt động rất tốt.
Chúc bạn 1 ngày làm việc vui !

 

[A Đặng]

Dear PacificPR .
Hôm bữa bạn có giúp mình về code tạo đường line, mình vẫn áp dụng được vào một số trường hợp. Tuy nhiên lại không được hiểu rõ lắm về câu lệnh tạo đường line, hay những yếu tố như BeginX, BeginY, EndX,EndY nó có tác dụng như thế nào?
Bạn có thể giải thích giúp mình được không ? Hay có tài liệu nào về nó ?
Cám ơn nhiều !
Chúc buổi tối vui vẻ !

Bài đã được tự động gộp: 14/1/19

Bạn thử Code này xem

Sub Addshapetocell()
    Dim ws As Worksheet, s As Shape, eRng As Range
    Dim BeginX As Double, BeginY As Double, EndX As Double, EndY As Double
    Dim Er As Long, Ec As Long
Set ws = ActiveSheet
Set eRng = ws.Range("B11")
Application.ScreenUpdating = False
For Each s In ws.Shapes
    If Not (s.Type = msoOLEControlObject Or s.Type = msoFormControl) Then s.Delete
Next s
With ws
    Er = .Range("D65535").End(3).Row:    Ec = eRng.Row - 1
    For j = 2 To 7
        BeginX = .Range(Cells(Er, 1), .Cells(Er, j)).Width
        BeginY = .Range(Cells(1, j), .Cells(Er, j)).Height
        EndX = .Range(.Cells(Ec, 1), .Cells(Ec, j - 1)).Width
        EndY = .Range(.Cells(1, j - 1), .Cells(Ec, j - 1)).Height
        Set s = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)
        s.Name = "S_" & j
        ActiveSheet.Shapes.Range(Array(s.Name)).Select
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorText1
        End With
    Next j
End With
Set s = Nothing
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Dear PacificPR .
Hôm bữa bạn có giúp mình về code tạo đường line, mình vẫn áp dụng được vào một số trường hợp. Tuy nhiên lại không được hiểu rõ lắm về câu lệnh tạo đường line, hay những yếu tố như BeginX, BeginY, EndX,EndY nó có tác dụng như thế nào?
Bạn có thể giải thích giúp mình được không ? Hay có tài liệu nào về nó ?
Cám ơn nhiều !
Chúc buổi tối vui vẻ !

 

[HeSanbi]

@PacificPR
Sao lại là:

Set s = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)
s.Name = "S_" & j
ActiveSheet.Shapes.Range(Array(s.Name)).Select
With Selection.ShapeRange.Line

Sao không như thế này để gọn hơn:

With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY).Line
     '.......
     '.......
      .Parent.Name = "S_" & j

BeginX, BeginY, EndX,EndY

Function AddConnector(Type As MsoConnectorType, BeginX As Single, BeginY As Single, EndX As Single, EndY As Single) As Shape

MsoConnectorType gồm 4 kiểu:
1. msoConnectorTypeMixed = -2 (&HFFFFFFFE)
2. msoConnectorStraight = 1
3. msoConnectorElbow = 2
4. msoConnectorCurve = 3

BeginX: Khoảng cách Tính từ Điểm đầu của Shape đến Giới hạn trái của Sheet
EndX: Khoảng cách Tính từ Điểm cuối của Shape đến Giới hạn trái của Sheet
BeginY: Khoảng cách Tính từ Điểm đầu của Shape đến Giới hạn trên của Sheet
EndY: Khoảng cách Tính từ Điểm cuối của Shape đến Giới hạn trên của Sheet

 

[A Đặng]

@PacificPR
Sao lại là:

Set s = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)
s.Name = "S_" & j
ActiveSheet.Shapes.Range(Array(s.Name)).Select
With Selection.ShapeRange.Line

Sao không như thế này để gọn hơn:

With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY).Line

Function AddConnector(Type As MsoConnectorType, BeginX As Single, BeginY As Single, EndX As Single, EndY As Single) As Shape

MsoConnectorType gồm 4 kiểu:
1. msoConnectorTypeMixed = -2 (&HFFFFFFFE)
2. msoConnectorStraight = 1
3. msoConnectorElbow = 2
4. msoConnectorCurve = 3

BeginX: Khoảng cách Tính từ Điểm đầu của Shape đến Giới hạn trái của Sheet
EndX: Khoảng cách Tính từ Điểm cuối của Shape đến Giới hạn trái của Sheet
BeginY: Khoảng cách Tính từ Điểm đầu của Shape đến Giới hạn trên của Sheet
EndY: Khoảng cách Tính từ Điểm cuối của Shape đến Giới hạn trên của Sheet

4 kiểu mso có khác gì nhau không ạ?

 

[HeSanbi]

4 kiểu mso có khác gì nhau không ạ?

Sao không thử đổi kiểu trong Code của bạn rồi chạy thử

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, EndY)