Tạo slide và ô textbox từ excel

tuhocvba

Administrator
Thành viên BQT
Đ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

Biên Tập Viên
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
Bài viết liên quan:
 
Top