Tạo slide và ô textbox từ excel

tuhocvba · 17/6/19

Đoạn code dưới đây sẽ tạo mới slide, dòng title theo chỉ định, ô textbox theo chỉ định.

Mã:

       Sub creat_TxtBox()
Dim pp As PowerPoint.Application, pptdoc As Slide, pptLayout As CustomLayout


Set pp = CreateObject("PowerPoint.Application")
pp.Visible = True

'If you are creating a new Presentation and New slide the
pp.Presentations.Add
Set pptLayout = pp.ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1)

Set pptdoc = pp.ActivePresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Title
pptdoc.Shapes.Title.TextFrame.TextRange.Text = "tuhocvba"


Set sldTitle = pptdoc.Shapes.Title

With sldTitle
With .TextFrame.TextRange
With .Font
.Bold = msoTrue
.Size = 32
.Color = RGB(0, 0, 200)
End With
End With
End With

sldTitle.Top = 10


'If you are using an existing presentation then delete above 3 lines use the 2 lines below
'pp.Presentations.Open ("C:\users\User\desktop\test.pptm")
'Set pptdoc = pp.ActivePresentation.Slides(1)

Set Sh = pptdoc.Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=100, Width:=150, Height:=60)
Sh.TextFrame.TextRange.Text = "TuhocVBA"
Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)

'them
'Create shape with Specified Dimensions and Slide Position
Set Shp = pptdoc.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=24, Top:=65.6, Width:=672, Height:=26.6)

'FORMAT SHAPE
'Shape Name
Shp.Name = "My Header"

'No Shape Border
Shp.Line.Visible = msoTrue 'msoFalse

'Shape Fill Color
Shp.Fill.ForeColor.RGB = RGB(184, 59, 29)

'Shape Text Color
Shp.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)

'Text inside Shape
Shp.TextFrame.TextRange.Characters.Text = "[Header]"

'Center Align Text
Shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter

'Vertically Align Text to Middle
Shp.TextFrame2.VerticalAnchor = msoAnchorMiddle

'Adjust Font Size
Shp.TextFrame2.TextRange.Font.Size = 14

'Adjust Font Style
Shp.TextFrame2.TextRange.Font.Name = "Arial"

End Sub

Kết quả:

Bạn cần đăng nhập để thấy hình ảnh

Euler · 23/6/19

Giả sử chúng ta có sẵn một slide, trên đó có một shape tên là "tuhocvba", bài toán của chúng ta là tạo ra các ô textbox sắp xếp bên trái shape này theo thứ tự lần lượt từ trên xuống.

Bạn cần đăng nhập để thấy hình ảnh

Ta có code như sau:

Mã:

Sub creat_TxtBox()
Dim oPA                 As PowerPoint.Application
Dim oPP                 As PowerPoint.Presentation  'lam viec voi file powerpoint

Dim Shp                 As Object
Dim i                   As Integer

'Kich thuoc graph tuhocvba
Dim w1, h1, t1, l1      As Double
'Kich thuoc cac shape tin hieu
Dim h2, t2, l2          As Double
Const w2                As Double = 140
Const kheho             As Double = 2
Dim kheho_temp          As Double

Const count_th          As Integer = 20 'so luong tin hieu





Const lkfileppt As String = "file:///C:\Users\jpnfriend.net\Desktop\VBA\Presentation1.pptx"

Set oPA = CreateObject("PowerPoint.Application") 'Mo ung dung Powerpoint
oPA.Visible = True   'Ung dung duoc hien thi

Set oPP = oPA.Presentations.Open(lkfileppt)
oPA.ActiveWindow.View.GotoSlide (1)    'Mo trang slide 1
w1 = oPP.Slides(1).Shapes("tuhocvba").Width
h1 = oPP.Slides(1).Shapes("tuhocvba").Height
l1 = oPP.Slides(1).Shapes("tuhocvba").Left
t1 = oPP.Slides(1).Shapes("tuhocvba").Top

l2 = l1 + w1 + kheho
kheho_temp = kheho * (count_th + 1)
h2 = h1 - kheho_temp 'chieu cao cho all shape tin hieu
h2 = h2 / count_th 'chieu cao cho tung shape tin hieu

'Set pptdoc = oPP.ActivePresentation.Slides(1)
For i = 1 To count_th Step 1
    t2 = t1 + (kheho * i) + (i - 1) * h2
'them
'Create shape with Specified Dimensions and Slide Position
    Set Shp = oPP.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=l2, Top:=t2, Width:=w2, Height:=h2)
    
    'FORMAT SHAPE
    'Shape Name
    Shp.Name = "tuhocvba" & i
    
    'No Shape Border
    Shp.Line.Visible = msoTrue 'msoFalse
    
    'Shape Fill Color
    Shp.Fill.ForeColor.RGB = RGB(184, 59, 29)
    
    'Shape Text Color
    Shp.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
    
    'Text inside Shape
    Shp.TextFrame.TextRange.Characters.Text = "Tin hieu" & i
    
    'Center Align Text
    Shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft 'ppAlignCenter
    
    'Vertically Align Text to Middle
    Shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
    
    'Adjust Font Size
    Shp.TextFrame2.TextRange.Font.Size = 14
    
    'Adjust Font Style
    Shp.TextFrame2.TextRange.Font.Name = "Arial"

Next i
End Sub

Tạo slide và ô textbox từ excel

tuhocvba

Administrator

Euler

Administrator