User Profile
kinuasa
Brass Contributor
Joined 7 years ago
User Widgets
Recent Discussions
Re: Excel charts to Powerpoint exporting using VBA
jstolme Hi,　please try below code: Option Explicit Public Sub ChartsToPpt() Dim sht As Object Dim cht As Excel.ChartObject Dim appPpt As Object 'PowerPoint.Application Dim prs As Object 'PowerPoint.Presentation Dim chtTitle As String Set appPpt = CreateObject("PowerPoint.Application") appPpt.Visible = msoTrue Set prs = appPpt.Presentations.Open("C:\Test\Sample.pptx") For Each sht In ActiveWorkbook.Sheets If sht.Visible = xlSheetVisible Then sht.Select Select Case LCase(TypeName(sht)) Case "worksheet" For Each cht In sht.ChartObjects If cht.Chart.HasTitle = True Then chtTitle = cht.Chart.ChartTitle.Text cht.Select Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs, chtTitle Next Case "chart" If sht.HasTitle = True Then chtTitle = sht.ChartTitle.Text Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs, chtTitle End Select End If Next End Sub Private Sub PasteChart(ByVal PowerPointApplication As Object, _ ByVal TargetPresentation As Object, _ ByVal ChartTitle As String) Dim sld As Object 'PowerPoint.Slide Dim cnt As Long Const ppLayoutTitleOnly = 11 Const CtrlID1 = "PasteLinkedExcelChartDestinationTheme" Const CtrlID2 = "PasteExcelChartSourceFormatting" Set sld = TargetPresentation.Slides.Add( _ TargetPresentation.Slides.Count + 1, ppLayoutTitleOnly) If sld.Shapes.HasTitle = msoTrue Then sld.Shapes.Title.TextFrame.TextRange.Text = ChartTitle sld.Select cnt = sld.Shapes.Count With PowerPointApplication If .CommandBars.GetEnabledMso(CtrlID1) = True Then .CommandBars.ExecuteMso CtrlID1 Else .CommandBars.ExecuteMso CtrlID2 End If End With Do DoEvents Loop Until cnt <> sld.Shapes.Count End Sub33KViews1like3CommentsRe: Excel charts to Powerpoint exporting using VBA
jstolme please try below code: Option Explicit Public Sub ChartsToPpt() Dim sht As Object Dim cht As Excel.ChartObject Dim appPpt As Object 'PowerPoint.Application Dim prs As Object 'PowerPoint.Presentation Set appPpt = CreateObject("PowerPoint.Application") appPpt.Visible = msoTrue Set prs = appPpt.Presentations.Open("C:\Test\Sample.pptx") For Each sht In ActiveWorkbook.Sheets If sht.Visible = xlSheetVisible Then sht.Select Select Case LCase(TypeName(sht)) Case "worksheet" For Each cht In sht.ChartObjects cht.Select Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs Next Case "chart" Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs End Select End If Next End Sub Private Sub PasteChart(ByVal PowerPointApplication As Object, _ ByVal TargetPresentation As Object) Dim sld As Object 'PowerPoint.Slide Dim cnt As Long Const ppLayoutBlank = 12 Const CtrlID1 = "PasteLinkedExcelChartDestinationTheme" Const CtrlID2 = "PasteExcelChartSourceFormatting" Set sld = TargetPresentation.Slides.Add( _ TargetPresentation.Slides.Count + 1, ppLayoutBlank) sld.Select cnt = sld.Shapes.Count With PowerPointApplication If .CommandBars.GetEnabledMso(CtrlID1) = True Then .CommandBars.ExecuteMso CtrlID1 Else .CommandBars.ExecuteMso CtrlID2 End If End With Do DoEvents Loop Until cnt <> sld.Shapes.Count End Sub33KViews1like5CommentsRe: XPath and name space
fdlsmg-ladnsgamgdn1390 Hi, I recommend using setProperty Method. Public Sub Sample() With CreateObject("MSXML2.DOMDocument") .async = False If .Load("C:\Test\Test.xml") Then .SetProperty "SelectionNamespaces", "xmlns:n1='http://www.unece.org/cefact/namespaces/StandardBusinessDocumentHeader'" Debug.Print .SelectNodes("//n1:Identifier").Item(0).XML End If End With End Sub ref. https://support.microsoft.com/en-us/help/288147/how-to-use-xpath-to-query-against-a-user-defined-default-namespace Best regards, kinuasa1.5KViews0likes0CommentsRe: vba sending email w/ attachment
Hi, Message object is not have a Attachment property. there is an Attachments property, but it is read only. Use the AddAttachment method when you want to attach a file. https://devblogs.microsoft.com/scripting/how-can-i-attach-a-file-to-an-email-sent-using-cdo/ Regards, kinuasa7.1KViews0likes2CommentsRe: Add or register an ActiveX control
Hi, I think below site will be helpful. Register the calendar control in your system regsvr32.exe XXXXX.ocx [How to create calendar in Excel (drop-down and printable)] https://www.ablebits.com/office-addins-blog/2016/10/12/insert-calendar-excel-datepicker-template/ Hope this helps kinuasa8.7KViews0likes1CommentRe: Excel charts to Powerpoint exporting using VBA
Hi, please try the sample code below: Public Sub ChartsToPpt() Dim sht As Object Dim cht As Excel.ChartObject Dim appPpt As Object 'PowerPoint.Application Dim prs As Object 'PowerPoint.Presentation 'Create New Presentation Set appPpt = CreateObject("PowerPoint.Application") appPpt.Visible = msoTrue Set prs = appPpt.Presentations.Add(msoTrue) For Each sht In ActiveWorkbook.Sheets If sht.Visible = xlSheetVisible Then sht.Select Select Case LCase(TypeName(sht)) Case "worksheet" For Each cht In sht.ChartObjects cht.Select Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs Next Case "chart" Application.CommandBars.ExecuteMso "Copy" PasteChart appPpt, prs End Select End If Next End Sub Private Sub PasteChart(ByVal PowerPointApplication As Object, _ ByVal TargetPresentation As Object) Dim sld As Object 'PowerPoint.Slide Dim cnt As Long Const ppLayoutBlank = 12 Set sld = TargetPresentation.Slides.Add( _ TargetPresentation.Slides.Count + 1, ppLayoutBlank) 'Add New Slide sld.Select cnt = sld.Shapes.Count PowerPointApplication.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting" Do DoEvents Loop Until cnt <> sld.Shapes.Count End Sub ------------- Public Sub ChartsToPptAsImage() Dim sht As Object Dim cht As Excel.ChartObject Dim appPpt As Object 'PowerPoint.Application Dim prs As Object 'PowerPoint.Presentation 'Create New Presentation Set appPpt = CreateObject("PowerPoint.Application") appPpt.Visible = msoTrue Set prs = appPpt.Presentations.Add(msoTrue) For Each sht In ActiveWorkbook.Sheets If sht.Visible = xlSheetVisible Then Select Case LCase(TypeName(sht)) Case "worksheet" For Each cht In sht.ChartObjects cht.CopyPicture Appearance:=xlScreen, _ Format:=xlBitmap PasteChartImage prs Next Case "chart" sht.ChartArea.Copy PasteChartImage prs End Select End If Next End Sub Private Sub PasteChartImage(ByVal TargetPresentation As Object) Dim sld As Object 'PowerPoint.Slide Const ppLayoutBlank = 12 Const ppPasteBitmap = 1 Set sld = TargetPresentation.Slides.Add( _ TargetPresentation.Slides.Count + 1, ppLayoutBlank) 'Add New Slide With sld.Shapes.PasteSpecial(DataType:=ppPasteBitmap, Link:=msoFalse) .Align msoAlignCenters, True .Align msoAlignMiddles, True End With End Sub hope this helps. kinuasa34KViews0likes12Comments
Groups
Recent Blog Articles
No content to show