Is there a method available for copying a section out of a shape to another shape using VBA? I'm specifically trying to copy all the custom properties and user cells from one pagesheet to another page.
Unfortunately there isn't a simple method to do this. You will have to loop over all the rows in the source sheet and create the same rows in the destination sheet. E.g.:
Dim oPageSheet1 As Visio.Shape
Dim oPageSheet2 As Visio.Shape
Dim rowName As String
Dim i As Integer
Set oPageSheet1 = Visio.ActiveDocument.Pages.Item(1).PageSheet
Set oPageSheet2 = Visio.ActiveDocument.Pages.Item(2).PageSheet
i = visRowUser
While oPageSheet1.CellsSRCExists(visSectionUser, i, visUserValue, False)
oPageSheet2.AddNamedRow visSectionUser, oPageSheet1.Section(visSectionUser).Row(i).NameU, 0
oPageSheet2.Section(visSectionUser).Row(i).Name = oPageSheet1.Section(visSectionUser).Row(i).Name
oPageSheet2.CellsSRC(visSectionUser, i, visUserValue).FormulaU = oPageSheet1.CellsSRC(visSectionUser, i, visUserValue).FormulaU
oPageSheet2.CellsSRC(visSectionUser, i, visUserPrompt).FormulaU = oPageSheet1.CellsSRC(visSectionUser, i, visUserPrompt).FormulaU
i = i + 1
Wend
If you have to copy a large number of rows and performance is a consideration you should investigate using AddRows and SetFormulas.
Related
I'm looking for a way to have three different colors in the same line chart of a diagram in Excel, depending on the values themselves or where they are from (from which sheet f.e).
Till now, I have the following code:
Sub ChangeColor()
Dim i As Integer
Dim IntRow As Integer
Dim r As Range
ActiveSheet.ChartObjects("Cash").Activate
ActiveChart.SeriesCollection(1).Select
IntRow = ActiveChart.ChartObjects("Cash").Count
For i = 2 To IntRow
Set r = Cells(2, i)
If r.Value < 3000 Then
Selection.Border.ColorIndex = 5
Else
Selection.Border.ColorIndex = 9
End If
Next
End Sub
However, the if statement is not considered and the color of the whole line changes only whenever I change the first ColorIndex. I have no idea, how to color parts of the line depending on the values in the underlying table.
Moreover, by defining IntRow as ActiveChart.ChartObjects("Cash").Count I'm not able to get the length of my array. This problem can be solved by manual counting and declaring IntRow as an Integer, however, the version above seems nicer (if that is possible of course).
I appreciate any help! Thank you.
Alexandra
You can read the values directly from the chart series:
Sub ChangeColor()
Dim cht As Chart, p As Point, s As Series
Dim i As Integer
Dim numPts As Long
'access the chart directly - no select/activate required
Set cht = ActiveSheet.ChartObjects("Cash").Chart
'reference the first series
Set s = cht.SeriesCollection(1)
'how many points in the first series?
numPts = s.Points.Count
'loop over the series points
For i = 1 To numPts
Set p = cht.SeriesCollection(1).Points(i)
p.Border.ColorIndex = IIf(s.Values(i) < 3000, 5, 9)
Next
End Sub
I've built a name range for 20 cells so that I can input a new list of projects which will vary from 1 to 20. I want to write a macro so that it reads the number of projects and creates the correct number of tabs, and names the tab after the project name listed in the named range. I've done all of this except I can't get the countA function to work. The named range is csCount. if I change the For loop to the correct number in one instance (if I put 7 because right now I have 7 projects) the loop and macro are correct. I want to make it more dynamic using the countA. Thank you very much for the help.
Sub generateDepartments()
Dim tabs As Integer
Dim sName As String
Dim i As Integer
Dim j As Integer
Dim csCount As Variant
tabs = Application.CountA(csCount)
j = 5
i = tabs
For i = 2 To Application.CountA(csCount)
Worksheets("Input").Activate
sName = Cells(j, 3).Value
Worksheets.Add(after:=Worksheets(i)).Name = sName
j = j + 1
Next
End Sub
First you need to create a variable to access your named range: Set csCount = ActiveWorkbook.Names("csCount").RefersToRange or Set csCount = ActiveSheet.Range("csCount")
Then use Application.WorksheetFunction.CountA(csCount)
Also, is better to define as a Range instead of Variant Dim csCount As Range
I have a scrolling datagridview that dyanmically changes it's number of columns and rows. I'm looking for a way to export the datagridview as it is when the user clicks a button. I want it to export as something that cannot be edited (so not excel file). I've tried using iTextSharp to export as pdf and can't seem to come up with a dynamically changing loop that would suit it. Also, I haven't been able to find any sample code using iTextSharp that included also exporting row headers along with column headers. I've also tried one solution (that I can't seem to find at the moment) on the microsoft forums that takes advantage of a the add-on functionality of Excel to write to PDF after the datagridview contents are exported to it. The problem I have with that is it creates way to many pages as well as still shows rows that have been hidden or deleted from the datagridveiw. Any idea of how I can accomplish this feat?
I'll include two pictures to show the way in which the datagridview is dynamically populated and changes
It can have up to 66 rows and 12 columns (not including row or column headers)
You can use EPPlus to create an password-protected (locked) excel file that can be read, but not edited. I can show you how to start from a situation like this:
and get a protected file like this:
First you must download and include the EPPlus Library in your project. Don't forget to check the great EPPlusSamples Project
Then you need a method to extract your DataGridView VISIBLE data (you don't want the invisible column to be exported). I did it using a 2d array. This function accept a DataGridView parameter and returns a 2d array:
Function GetDataGridView2DArray(ByVal dataGridView As DataGridView) As String(,)
'Save list of visible columns
Dim nrVisibleColumns = (From c As DataGridViewColumn In DataGridView1.Columns
Where c.Visible
Select c).ToList()
'create 2d-array to store values, dimensions given by number of rows and visible columns
Dim dgvArray(nrVisibleColumns.Count, DataGridView1.Rows.Count) As String
'create the first row with Column Headers text
For Each col As DataGridViewColumn In nrVisibleColumns
dgvArray(col.Index + 1, 0) = col.HeaderText
Next
'create Rows, including Row Header text
For Each row As DataGridViewRow In DataGridView1.Rows
Dim rowNumber = row.Index + 1
dgvArray(0, rowNumber) = DataGridView1.Rows(row.Index).HeaderCell.Value 'save rowheader cell value
For Each col As DataGridViewColumn In nrVisibleColumns
dgvArray(col.Index + 1, rowNumber) = DataGridView1(col.Index, row.Index).Value
Next
Next
Return dgvArray
End Function
Now that you have your array you can create an Excel File and fill it with data. Plus, before saving, we'll lock it with a password to prevent user editing.
Private Sub CreateXls()
Dim fi = New FileInfo("C:\temp\output.xlsx")
Dim package As New ExcelPackage()
Dim ws = package.Workbook.Worksheets.Add("Dgv Output") 'create sheet
'get array of datagridview data
Dim dataArray = GetDataGridView2DArray(DataGridView1)
'loop my 2d array and fill my excel file
For iColumn As Integer = dataArray.GetLowerBound(0) To dataArray.GetUpperBound(0)
For iRow As Integer = dataArray.GetLowerBound(1) To dataArray.GetUpperBound(1)
ws.Cells(iRow + 1, iColumn + 1).Value = dataArray(iColumn, iRow)
ws.Cells(iRow + 1, iColumn + 1).Style.Locked = True 'lock the cell
Next
Next
ws.Cells.AutoFitColumns() 'resize columns to fit
ws.Protection.AllowFormatColumns = True 'let user resize columns if he wants
ws.Protection.SetPassword("1") 'protect the sheet from editing
package.SaveAs(fi) 'save file
End Sub
Now you should be able to easily export your dynamic DataGridView with one click.
This is My Coding Tested And Output is Perfect :
Dim ExcelApp As Object, ExcelBook As Object
Dim ExcelSheet As Object
Dim i As Integer
Dim j As Integer
'create object of excel
ExcelApp = CreateObject("Excel.Application")
ExcelBook = ExcelApp.WorkBooks.Add
ExcelSheet = ExcelBook.WorkSheets(1)
With ExcelSheet
For Each col As DataGridViewColumn In Me.DataGridView1.Columns
ExcelSheet.Cells(1, col.Index + 1) = col.HeaderText.ToString
For i = 1 To Me.DataGridView1.RowCount
ExcelSheet.cells(i + 1, 1) = Me.DataGridView1.Rows(i - 1).Cells("First Column Name").Value
For j = 1 To DataGridView1.Columns.Count - 1
ExcelSheet.cells(i + 1, j + 1) = DataGridView1.Rows(i - 1).Cells(j).Value
Next
Next
Next
End With
ExcelApp.Visible = True
ExcelSheet = Nothing
ExcelBook = Nothing
ExcelApp = Nothing
I am trying to import a spreadsheet that has a question on each row along with 4 possible answers. I can successfully read the cell values, but the correct answer is indicated by a fill pattern (50% Gray). I am using the code below to loop through the worksheet and pick out the correct answers. However, the value of Pattern seems to be the same for all columns, even though the pattern is plainly visible on the worksheet. Am I looking in the wrong place?
The worksheet is an .xls file. I am using Excel 2010 and VS 2010.
Dim dt As New System.Data.DataTable
Dim wks As Worksheet = wkb.Worksheets(1)
Dim ur As Range = wks.UsedRange
' Load all cells into an array.
Dim SheetData(,) As Object = ur.Value(XlRangeValueDataType.xlRangeValueDefault)
' Loop through all cells.
For j As Integer = 1 To SheetData.GetUpperBound(0)
For k As Integer = 1 To (SheetData.GetUpperBound(1) - 1)
'Get the pattern for the cells in columns 7 - 10
If (k > 6) And (k < 11) Then
Dim r As Range = wks.Cells(j, k)
Dim s As Style = r.Style
If s.Interior.Pattern = XlPattern.xlPatternGray50 Then
'Convert column index to "A" - "D"
Dim key As Char = ChrW(k + 58)
'Do something with key
End If
End If
Next
Next
I looked in MSDN but they give little or no explanation of how styles are stored in the object model. The few examples that I have seen show using the Style.Interior.Pattern to set the value after selecting the cell. Do I need to select the cell to read the pattern?
Any help would be appreciated.
Interior.Pattern is accessible from a Range object. The Range interface/object contains all the style and value information for the range.
The Style property of the Range object refers to Styles that are definied at workbook level ("shared" styles).
From MSDN:
The Style object contains all style attributes (font, number format, alignment, and so on) as properties. There are several built-in styles, including Normal, Currency, and
Percent. Using the Style object is a fast and efficient way to change
several cell-formatting properties on multiple cells at the same time.
In your case (where the styles seems to be definied at cell level and not by using a "shared" style), you just need to replace:
Dim r As Range = wks.Cells(j, k)
Dim s As Style = r.Style
If s.Interior.Pattern = XlPattern.xlPatternGray50 Then
With:
Dim r As Range = wks.Cells(j, k)
'Dim s As Style = r.Style 'no need
If r.Interior.Pattern = XlPattern.xlPatternGray50 Then
the line that is giving me trouble is ""Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste""
this is supposed to find the tab name in column 3 and go to that tab and paste the tab name in that tab.
Const START_C = 3
Const MAX_TRAN = 1000
Const START_R = 2
Const MASTER = "MASTER"
Sub MOVEDATACORRECTLY()
Dim WS_M As Worksheet
Dim thisWB As Workbook
Set thisWB = ActiveWorkbook
Set WS_M = Worksheets(MASTER)
For M = START_R To (START_R + MAX_TRAN)
If WS_M.Cells(M, (START_C + 1)) = "" Then Exit For
Next M
M = M - 1
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Paste
Next n
End Sub
Try this instead:
For n = START_R To M
WS_M.Cells(n, START_C).Copy
Sheets(CStr(WS_M.Cells(n, START_C))).Cells(n, START_C).Select
ActiveSheet.Paste
Next n
If you look at the documentation for the Excel Range object, Paste is not in the list of members. There is PasteSpecial, however. I haven't experimented with that, but that might also work.
For copying a range of cells in Excel, using Copy method makes the VBA program easier to crash / or to give inpredictable results.
Suppose during the your procedure copies data from system clipboard and user was trying to store some other to system clipboard!
Not always, but from users this kind of mistake might happened.
So I always prefer to use a better approach, something like Swaping the range on the fly. Here's a small demonstration:
Public Sub Sample_Copy_without_Clipboard()
Dim dRange As Range, iRange As Range
Set iRange = Range("A1:B3")
Set dRange = Range("D1:E3")
dRange.Value = iRange.Value
End Sub
Note: This method works only with unformatted textual data. If not then either use Tim's suggestion or DanM's answer.