How to insert column in powerpoint using VBA - vba

The questions is bit tricky one, I have googled and got a link http://joelblogs.co.uk/2010/08/13/automatically-create-summary-slides-in-powerpoint-2010/ with VBA code which helps me to insert summary of the titles of all the other slides of one presentation in single parent slide.
The code is working fine, however when the number of slides with titles is more than 30 or 50 then the Table of content parent slide cannot hold the entire title names as the names will be hidden and go beyond the slide presentation.
Hence, I like to confirm are there any VBA code to distribute the contents of the summary names in to three columns through VBA in the table of contents slide ?

Based on the link where you have an example you need to add that code at the and of your macro:
With summary.Shapes(2).TextFrame2
.Column.Number = 3
End With
which set 3 columns in your summary text frame.
Remember, that you could need to set font size, too, to keep your text within text box.
Additional information: What I see is that font size changes (decrease) as long as you put more text into summary Shape (Shapes(2) in my example). You could then trace the font size to check if you should increase number of columns. Here is an example:
With summary.Shapes(2).TextFrame2
If .TextRange.Font.Size < 20 Then
'additionally check here if max approved column numbers is not exceeded.
.Column.Number = .Column.Number + 1
End If
End With
And here is my full basic test code (which could be run for any new empty presentation):
Sub test_loop()
Dim summary As Slide
Set summary = ActivePresentation.Slides.Add(1, ppLayoutText)
Dim enterText as string
Do
enterText = InputBox("Additional text to insert into Shape:")
With summary.Shapes(2).TextFrame2
.TextRange.Text = .TextRange.Text & Chr(10) & enterText
If .TextRange.Font.Size < 20 Then
.Column.Number = .Column.Number + 1
End If
End With
Loop While enterText <> ""
End Sub

Related

How to make textbox inputs numbers with 2 decimal places and then check their sum?

struggling with something in VBA and can't find a clear answer online. Quite new to this. Basically, for the user form below (linked image due to my level), I would like to make all the textbox inputs be numbers (2 decimal places) and then when you click "Next" it checks that all the values sum to 100. If not, error message appears. I've tried lots of different ways of doing this and can't get it to work. I would like for all textbox inputs to be numbers (2dp), and then all the numbers to just add and then check this sum. For each textbox, I've done the following Sub Routine (variable name changes each time for name of textbox):
Private Sub BinQnt_AfterUpdate()
On Error Resume Next
Dim BinQnt As Single
BinQnt = Format(BinQnt, "percent")
End Sub
For the Next button I have done the following:
Private Sub MaterialsData_Next_Click()
'Check mix design = 100%.
'If = 100%, input data to database.
tot = BinQnt + FillQnt + FineQnt + CoarQnt + RAPQnt + CRQnt 'Names of each text box.
If tot = 100 Then
'Code here for inserting values into database. Omitted to save space and confusion.
'Go to next page.
BaseUserForm.MultiPage1.Value = 2
'If doesn't = 100%, then show error MsgBox
Else
MsgBox "Error, please check mixture design sums to 100%. Currently at " & tot & "."
End If
Screenshot of userform.

How to add list boxes and text boxes in Excel VBA Userforms dynamically as needed?

I do not know if this is appropriate to place in stackoverflow despite being VBA related--particularly in the UserForms area, however, I cannot visualize at all how i'm going to code this.
My Excel worksheet is shown below:
The UserForm I created to input the data is as shown below:
However, what I want to achieve is similar to how QuickBooks does it where the Amount Due is automatically distributed among the Expense Accounts without having to input them 1 by 1 as shown in the first image (My excel worksheet). Also, when there are more expense accounts than usual (e.g. 10 expense accounts, Quickbooks will automatically add new rows for that purpose). A sample is shown below:
My main issue is that I do not know how to let UserForms dynamically add more rows if I need to do so. It can be automatically add rows when all previous rows are filled or something as shown in the image below:
Let n be the number of expense accounts
So from having to input n*2 (or in my case 4 values):
Telephone/Insurance Expense: 40,000
Cash in Bank 40,000
Water Expense: 40,000
Cash in Bank: 40,000
I can to simplify it to n+1 inputs (or in my case 3 inputs):
Amount Due: 80,000
Telephone/Insurance Expense: 40,000
Water Expense 40,000
A lot of examples and tutorials how to add controls dynamically can be found, for example
how-to-create-controls-dynamically-at-runtime
adding-controls-to-a-frame-in-an-excel-userform-with-vba
vba-userform-basics-add-controls-dynamically-at-run-time
However, depending on the maximum number of lines, maybe it is a better solution to create all the controls at design time, set the Visible-property to false and change it to true when needed.
You can add controls based on the label click in the UserForm code.
You'll have to maintain a count of rows in order to utilize that to position them neatly and to move this label from your example down (otherwise it'll be hidden behind the textboxes you add).
Sample code for the UserForm:
Private rowCount As Integer 'To keep track of rows.
Private Sub UserForm_Initialize()
rowCount = 1
End Sub
Private Sub LabelAddRow_Click() 'Event handler: Add row on click of label.
Dim tb As Control
rowCount = rowCount + 1
Set tb = Me.Controls.Add("Forms.TextBox.1", "textBox" & rowCount & "left", True) 'Add left TextBox.
With tb 'Position and size it:
.Top = 25 + (rowCount * 25) + 10
.Left = 25
.Height = 25
.Width = 100
End With
Set tb = Me.Controls.Add("Forms.TextBox.1", "textBox" & rowCount & "right", True) 'Same for the right one:
With tb
.Top = 25 + (rowCount * 25) + 10
.Left = 150
.Height = 25
.Width = 100
End With
LabelAddRow.Top = LabelAddRow.Top + 25 'Move the label down.
End Sub
You might want to add something to the height of the UserForm too, to make it grow with the added controls. Also you might want to reposition other controls that are below the TextBoxes.
If you want to automatically add rows when the last box has been filled out, you're going to need to add some events to the newly added controls, however that's not the main issue listed in the question.
Edit: The above is obviously based on your last image, since that's the "quick win"; dealing with the events of dynamically added TextBoxes will add additional complexity. If you decide to take that route, I suggest to have a go at this first and post new questions as they come along.

Excel VBA to Create Header ERROR

I am currently using the below macro to customize the header based off the contents of cell B3 within spreadsheet "Reference", and have been using it sometime now.
I'm currently running into an issue where the header font is becoming very large. The header becomes so large, that if I print the spreadsheet (which I do often with this file) it monopolizes the entire page - in other words - the header overtakes the entire print area because it's so large.
Is anyone able to see where I'm going wrong with the macro or have an idea as to why this is occurring and how to resolve this issue?
----
'=========================================================================
' Custom Header based on value of specified cell
'=========================================================================
Sub HeaderFont()
ActiveSheet.PageSetup.RightHeader = "&""Calibri,bold""&11" & Sheets("Reference").Range("B3")
End Sub
Maybe you would be interested by something like the code below.
It checks the length of the string in cell "B3" and according to the length (using Select Case) it sets the Header font size. You will need to adjust the values inside the Cases to fit your needs.
Option Explicit
'=========================================================================
' Custom Header based on value of specified cell
'=========================================================================
Sub HeaderFont()
Dim FntSize As Integer
Select Case Len(Sheets("Reference").Range("B3"))
Case Is > 300 ' <-- length of string is more than 300 characters
FntSize = 11
Case Is > 200 ' <-- length of string is more than 200 characters
FntSize = 12
Case Else
FntSize = 13
' you can add more Cases to have more scenarios
End Select
ActiveSheet.PageSetup.RightHeader = "&""Calibri,Bold""&" & FntSize & "" & Sheets("Reference").Range("B3")
End Sub

Excel VBA Pivot Table Fill Header

In excel vba I am creating a pivot table and want to fill the header (first two rows) and bottom line (1 row) blue with white font.
The below code fills in the interior of the first data set row rather than the header.
With ActiveSheet.PivotTables(1).TableRange1
.Cells.Borders.LineStyle = xlContinuous
.Range("A3:I4").Interior.ColorIndex = 49
.Range("A13:I13").Interior.ColorIndex = 49
End With
Is there a way to dynamically reference the header and the last line of the pivot table? It would be better to reference "pivot table header" than specific ranges incase values of the report change.
you can simply use this:
With ActiveSheet.PivotTables("PivotTable1")
Debug.Print "full headers at: " & Intersect(.Parent.Range(.TableRange1.Row & ":" & .DataBodyRange.Row - 1), .TableRange1).Address
Debug.Print "last row-range at: " & .TableRange1.Rows(1).Offset(.TableRange1.Rows.Count - 1).Address
End With
but looking at your sub, the easiest way would be to change:
.Range("A3:I4").Interior.ColorIndex = 49
.Range("A13:I13").Interior.ColorIndex = 49
to:
Union(.Rows("1:2"), .Rows(.Rows.Count)).Interior.ColorIndex = 49
There is a dynamic way to address the header rows and the last row:
Dim pvtFirstRow, pvtLastRow As Integer
pvtFirstRow = ActiveSheet.PivotTables(1).TableRange1.row + x ' modify x to the first row where your Pivot data starts
pvtLastRow = ActiveSheet.PivotTables(1).TableRange1.Cells(ActiveSheet.PivotTables(1).TableRange1.Cells.count).row
The code presented in the thread so far does work, but will have to be rerun in future: Any time the number of rows or columns in the pivot changes, you may sit with coloured rows or columns where there is no pivot, or coloured cells in the wrong part of the pivot.
I suggest you look at the built in pivot styles of Excel, pick the one closest to what you need, and use code like this to modify the header row(s) and the grand total row. There is no need to manipulate ranges of cells, because next time you might want to turn off the total row (for argument's sake) but the range will still be coloured.
I recorded a macro and removed all redundant lines of code to help you see what changes. I also remove one useful row (.TintAndShade = ) and replaced it with a "ColorIndex = " statement in order to force the shade of blue you seem to prefer.
After running this, you should have the same style available to all other (existing and new) pivots in the same workbook. You could even make it default. No need to run code again to format when your pivot [refreshed] covers a different range of cells.
You can pick another style one from your own palette and use your own custom name for the copy, as long as you find and replace all relevant strings in the sample code below or record your own actions:
Sub ColourPivotStyleForThisBook()
'duplicate blue/medium pivot style from template
ActiveWorkbook.TableStyles("PivotStyleMedium2").Duplicate ("PivotStyleMedium2v2" _
)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2")
.ShowAsAvailablePivotTableStyle = True
.ShowAsAvailableTableStyle = False
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
End With
'now modify header's style (fill) (font colour is white/automatic already)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2").TableStyleElements( _
xlHeaderRow).Interior
'only one/two lines are changing the colours
' .TintAndShade = -0.249977111117893
.ColorIndex = 49
End With
'now modify grand total row's style (fill) (font colour is white/automatic already)
With ActiveWorkbook.TableStyles("PivotStyleMedium2v2").TableStyleElements( _
xlTotalRow).Interior
'only one/two lines are changing the colours
' .TintAndShade = -0.249946592608417
.ColorIndex = 49
End With
End Sub
If the result you get is not what you're after, simply select part of a pivot in the workbook, tap the Design tab of the PivotTable Tools ribbon, right-click on the one your code has created (it should be in the Custom section at the top), and click Delete. Hope this helps.
(You can even use code like the above to customise PivotTable styles in other workbooks that don't have PivotTables yet.)

Resize pivot chart when selecting different less/more values

When creating the pivot chart using VBA, I set the size of the chart depending on the number of different values that I have in the chart. With pivot charts you have the option to select only some values of the chart. So for example if I have this chart:
And then I select only 2 I get this:
This is too big and sometimes it can be even bigger. What I would like is to resize it automatically when a user select less so that it automatically become smaller. So I would like it to be something like this:
Is there any way to change the width automatically using VBA?
You may want to take a look at these: resize (mrexcel) & Count number of series (stackoverflow)
In these sources there are some code snippets for getting the number of series in a chart and resizing charts to a fit to a range in the worksheet
Im by no means an expert coder, but with the code and concepts in the above you may be able to do something like this to a given ChartObject:
'get the number of series in a given ChartObject:
numberOfSeries = ChartObject.Chart.SeriesCollection.Count
'you can use this to specify a width in cells/as a range. For the purpose of this example I
'eventually want the chart to cover 1 cell width for each series, + 1.
myChartWidth = numberOfSeries + 1
'Give the chart a name. Smarter people may supply a solution that reference the ChartObject
'directly, but I am not that clever
ChartObject.Name = "Your Chart"
'I will use A1 as reference for setting width, change as you see fit
Sheet1.Shapes("Your Chart").Width = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, myChartWidth)).Width
'I assume you want to fix the height, adjust to your requirements
Sheet1.Shapes("Your Chart").Height = Sheet1.Range("A1:A10").Height
'If you want to also place the chart top left corner in the in the top left of A1, you can do the following
Sheet1.Shapes("Your Chart").Left = Sheet1.Cells(1, 1).Left
Sheet1.Shapes("Your Chart").Top = Sheet1.Cells(1, 1).Top
You probably want to place and size it differently, but I hope the ideas or the linked sources can get you closer to a solution
Finally I found a solution using the change event. So when I select different values I check how many values I have and then resize my chart depending on the values quantity.
Here is an example of what I used (I have 2 different pivot tables in my sheet)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
If Target.PivotTable.Name = "PivotTable1" Then
Sheets("PerPublication").Shapes(1).Width = (Target.PivotTable.RowRange.Count * 50) + 100
End If
If Target.PivotTable.Name = "PivotTable2" Then
Sheets("PerPublication").Shapes(2).Width = (Target.PivotTable.RowRange.Count * 40) + 40
End If
GetOut:
If Err.Description <> "" Then
Err.Clear
End If
End Sub