Excel'den PowerPoint'e Aktarma скачать в хорошем качестве

Excel'den PowerPoint'e Aktarma

Excel'den PowerPoint’e veri aktarma Excel ile PowerPoint ortamında sunum oluşturma Microsoft Excel(R) ortamından verileri Microsoft PowerPoint(R) ortamına veri aktarmak. VBA ortamında yazılacak kodlar: Microsoft PowerPoint referansının eklenmesi gerekir. Onun dışında nesnelerin kullanımını bilmek yeterli. Sub PowerPointeaklar() ' powerpoint - pptye aktar Dim pptapp As PowerPoint.Application Dim pptsunum As PowerPoint.Presentation Dim pptslayt As PowerPoint.Slide Dim pptshape As PowerPoint.Shape Dim slaytsay As Long 'powerpoint aç Set pptapp = New PowerPoint.Application pptapp.Visible = True 'yeni sunum Set pptsunum = pptapp.Presentations.Add ' buradan itibaren Exceldeki veri kadar döngü içerisinde ' slayt oluşturma ve kutu ekleyerek görüntüleme For satir = 2 To Sayfa1.Range("a2").End(xlDown).Row slaytsay = pptsunum.Slides.Count Set pptslayt = pptsunum.Slides.Add(slaytsay + 1, Layout:=ppLayoutTitleOnly) ' slayt başlığını yazma pptslayt.Shapes.Title.TextFrame.TextRange.Text = "MÜŞTERİLER: " & satir - 1 ' kutu şekil ekleme ' şekil 1 Set pptshape = pptslayt.Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=150, Width:=150, Height:=70) With pptshape .Fill.ForeColor.RGB = RGB(10, 255, 10) .TextFrame.TextRange.Text = Sayfa1.Cells(satir, 1).Value ' Excelden müşteri .TextFrame.TextRange.Font.Name = "Arial" .TextFrame.TextRange.Font.Size = 16 .TextEffect.FontBold = msoTrue End With ' şekil 2 Set pptshape = pptslayt.Shapes.AddShape(Type:=msoShapeRectangle, Left:=250, Top:=150, Width:=150, Height:=70) With pptshape .Fill.ForeColor.RGB = RGB(255, 10, 10) .TextFrame.TextRange.Text = Sayfa1.Cells(satir, 2).Value ' satıcı .TextFrame.TextRange.Font.Name = "Arial" .TextFrame.TextRange.Font.Size = 16 .TextEffect.FontBold = msoTrue End With Set pptshape = pptslayt.Shapes.AddShape(Type:=msoShapeRectangle, Left:=450, Top:=150, Width:=150, Height:=70) With pptshape .Fill.ForeColor.RGB = RGB(50, 50, 50) .TextFrame.TextRange.Text = Format(Sayfa1.Cells(satir, 3).Value, "#,##0.00") ' ciro .TextFrame.TextRange.Font.Name = "Arial" .TextFrame.TextRange.Font.Size = 16 .TextEffect.FontBold = msoTrue End With Next ' döngü sonu End Sub Faruk Çubukçu - Bilgi Teknolojileri Danışmanlık www.farukcubukcu.com www.excelakademi.com