I can use VBA to loop through the columns of a table and change many properties related to the Column object itself. What I am looking for is to change the color of select columns of a table as displayed in a PDM diagram. It is possible to do this from the UI, by clicking on a column of a table to select it in a diagram, then right-click to display a context menu, then select 'Sub-Objects Format'.
Here is an example, which does that with some arbitrary criteria to write in red some Columns in a Physical Data Model, when their name contains a "b"... using the ObjectCompositeSymbol.SubObjects attribute.
option explicit
const workfont = "Arial,8,N,255,0,0"
dim diags: set diags = createobject("Scripting.Dictionary")
dim m : set m = activemodel
dim t
for each t in m.tables
' public name of subobjects: Column; 0: display all
dim sb : sb = "Column 0" + vbcrlf
dim c,some : some = false
for each c in t.columns
' our criteria is: column name contains a b
dim match : match = instr(lcase(c.name),"b") <> 0
if match then
sb = sb + "{"+ c.GetAttribute("ObjectID")+"} " + workfont + vbcrlf
some = true
end if
next
if not some then sb = ""
' apply subobjects coloring
dim s
for each s in t.symbols
if s.subobjects <> sb then
s.subobjects = sb
if not diags.exists(s.diagram) then diags.add s.diagram,0
end if
next
next
if diags.count > 0 then
dim d
for each d in diags.keys
output "... redraw "+d.name
d.RedrawAllViews
next
end if
Related
I have a report with a summary page that has all of the employee ID's listed and each employee belongs to a specific group. I'm trying to have my macro filter through the arrays for each group with each array containing the EID numbers and then export the filtered data into a separate sheet.
The issue I'm running into is, I have one group that contains about 20 EIDs and I'm using the "begin with filtering method" such as "1156*" which only seems to work with up to two values in the array only. I'm using this method because the EID's in the summary page are shown for example "11569-Org1". Any help to work around this would be appreciated.
Dim EIDNumbers(1 to 3) As Variant
EIDNumbers(1) = Array("16799*", "17900*")
EIDNumbers(2) = "22222*"
EIDNumbers(3) = Array("88888*","90000*","88444*")
For n = UBound(GroupNames) To LBound(GroupNames) Step -1
If IsArray(EIDNumbers(n)) Then
dataRG.AutoFilter 11, EIDNumbers(n), xlFilterValues
Else
dataRG.AutoFilter 11, EIDNumbers(n)
End If
Set fdataRG = mainWS.Range("A1").EntireColumn
fdataCT = Application.WorksheetFunction.Subtotal(103, fdataRG) - 1
If fdataCT > 1 Then ' add additional subws
Set subWS = wb.Worksheets.Add(After:=mainWS)
subWS.Name = OrgNames(n)
Set dfcell = subWS.Range("A1")
dataRG.SpecialCells(xlCellTypeVisible).Copy dfcell
End If
Next n
Filter Data When More Than Two WildCard Criteria
Dim LeftEIDs(1 To 3) As Variant
LeftEIDs(1) = Array("16799*", "17900*")
LeftEIDs(2) = Array("22222*")
LeftEIDs(3) = Array("88888*", "90000*", "88444*")
' Write the data (the EIDs) from the EID column to the keys of a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Data: Data = dataRG.Columns(11).Value
Dim rCount As Long: rCount = UBound(EIDs, 1)
Dim r As Long, cString As String
For r = 2 To rCount
cString = CStr(Data(r, 1))
If Len(cString) > 0 Then dict(cString) = Empty
Next r
' Write the matches per group to the keys of another dictionary
' and use them to filter by the EID column and to copy
' the data to a new worksheet.
Dim cDict As Object: Set cDict = CreateObject("Scripting.Dictionary")
cDict.CompareMode = vbTextCompare
Dim LeftEID, eKey, e As Long, n As Long
If mainWS.FilterMode Then mainWS.ShowAllData ' not sure about 'mainWS'!?
For n = UBound(LeftEIDs) To LBound(LeftEIDs) Step -1
For Each eKey In dict.Keys
For Each LeftEID In LeftEIDs(n)
If eKey Like LeftEID Then
cDict(eKey) = Empty
dict.Remove eKey
Exit For
End If
Next LeftEID
Next eKey
If cDict.Count > 0 Then
dataRG.AutoFilter 11, cDict.Keys, xlFilterValues
Set subWS = wb.Worksheets.Add(After:=mainWS)
subWS.Name = OrgNames(n)
Set dfcell = subWS.Range("A1")
dataRG.SpecialCells(xlCellTypeVisible).Copy dfcell
mainWS.ShowAllData ' not sure about 'mainWS'!?
cDict.RemoveAll
End If
Next n
'mainWS.autfiltermode = False ' not sure about 'mainWS'!?
I have an excel file which I receive daily. The number of columns in that file is not specific. My requirement is just to load the last column in my table through SSIS. How will I be able to identify last used column dynamically?
You can use c# script:
Make sure you add Using System.Data.OleDb; to the Namespaces Region
and add output Column LastCol and select data type.
public override void CreateNewOutputRows()
{
/*
Add rows by calling the AddRow method on the member variable named "<Output Name>Buffer".
For example, call MyOutputBuffer.AddRow() if your output was named "MyOutput".
*/
string fileName = #"C:\test.xlsx";
string SheetName = "Sheet1";
string cstr = "Provider.ACE.OLEDB.12.0;Data Source=" + fileName + ";Extended Properties=\"Excel 12.0;HDR=No;IMEX=1\"";
OleDbConnection xlConn = new OleDbConnection(cstr);
xlConn.Open();
OleDbCommand xlCmd = xlConn.CreateCommand();
xlCmd.CommandText = "Select * from [" + SheetName + "]";
xlCmd.CommandType = CommandType.Text;
OleDbDataReader rdr = xlCmd.ExecuteReader();
int rowCt = 0; //Counter
while (rdr.Read())
{
//skip headers
if (rowCt != 0)
{
int maxCol = rdr.FieldCount;
Output0Buffer.AddRow();
Output0Buffer.LastCol = (int)rdr[maxCol];
}
rowCt++; //increment counter
}
}
Solution Overview
Use a Script Task to:
Get the last column index
Use the following function to convert the index to Column Letter (ex: 1 -> A)
Private Function GetExcelColumnName(columnNumber As Integer) As String
Dim dividend As Integer = columnNumber
Dim columnName As String = String.Empty
Dim modulo As Integer
While dividend > 0
modulo = (dividend - 1) Mod 26
columnName = Convert.ToChar(65 + modulo).ToString() & columnName
dividend = CInt((dividend - modulo) / 26)
End While
Return columnName
End Function
Build the SQL Command that read only the last column
Choose this query as Excel Source
Detailed Solution
This answer is assuming that the Sheet Name is Sheet1, and the programming language used is VB.Net
First create an SSIS variable of type string (i.e. #[User::strQuery])
Add another variable that contains the Excel File Path (i.e. #[User::ExcelFilePath])
Add A Script Task, and select #[User::strQuery] as ReadWrite Variable, and #[User::ExcelFilePath] as ReadOnly Variable (in the script task window)
Set the Script Language to VB.Net and in the script editor window write the following script:
Note: you have to imports System.Data.OleDb
m_strExcelPath = Dts.Variables.Item("ExcelFilePath").Value.ToString
Dim strSheetname As String = String.Empty
Dim intLastColumn As Integer = 0
m_strExcelConnectionString = Me.BuildConnectionString()
Try
Using OleDBCon As New OleDbConnection(m_strExcelConnectionString)
If OleDBCon.State <> ConnectionState.Open Then
OleDBCon.Open()
End If
'Get all WorkSheets
m_dtschemaTable = OleDBCon.GetOleDbSchemaTable(OleDbSchemaGuid.Tables,
New Object() {Nothing, Nothing, Nothing, "TABLE"})
'Loop over work sheet to get the first one (the excel may contains temporary sheets or deleted ones
For Each schRow As DataRow In m_dtschemaTable.Rows
strSheetname = schRow("TABLE_NAME").ToString
If Not strSheetname.EndsWith("_") AndAlso strSheetname.EndsWith("$") Then
Using cmd As New OleDbCommand("SELECT * FROM [" & strSheetname & "]", OleDBCon)
Dim dtTable As New DataTable("Table1")
cmd.CommandType = CommandType.Text
Using daGetDataFromSheet As New OleDbDataAdapter(cmd)
daGetDataFromSheet.Fill(dtTable)
End Using
'Get the last Column Index
intLastColumn = dtTable.Columns.Count
End Using
'when the first correct sheet is found there is no need to check others
Exit For
End If
Next
OleDBCon.Close()
End Using
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
Dim strColumnname as String = GetExcelColumnName(intLastColumn)
Dts.Variables.Item("strQuery").Value = "SELECT * FROM [" & strSheetname & strColumnname & ":" & strColumnname & "]"
Dts.TaskResult = ScriptResults.Success
End Sub
Private Function GetExcelColumnName(columnNumber As Integer) As String
Dim dividend As Integer = columnNumber
Dim columnName As String = String.Empty
Dim modulo As Integer
While dividend > 0
modulo = (dividend - 1) Mod 26
columnName = Convert.ToChar(65 + modulo).ToString() & columnName
dividend = CInt((dividend - modulo) / 26)
End While
Return columnName
End Function
Then you have to add an Excel connection manager, and choose the excel file that you want to import (just select a sample to define the metadata for the first time only)
Assign a default value of Select * from [Sheet1$] to the variable #[User::strQuery]
In the Data Flow Task add an Excel Source, choose SQL Command from variable, and select #[User::strQuery]
Set the DataFlow Task Delay Validation property to True
Add other components to DataFlow Task
References
Importing excel files having variable headers
Converting Numbers to Excel Letter Column vb.net
No you can't do that. The number of columns and data types must be determined beforehand and can't be changed. Otherwise SSIS will fail. So no way to dynamically get the last column. Workaround is maybe get the last column from inside excel using some macro then use that as the source for SSIS.
I am new to LINQ query and writing a SSIS script task to read data from two data tables.
I have created the following query, where I want to output to be sent by an email as a table. The body of the email will be the output.
I am able to see the result. But dont know how to use this data (New to linq).
Here is my code:-
Dim Filename As String
Dim Filepath As String
Dim i As Integer
Filename = "TM_xxx_DAILY_*" + Dts.Variables("User::VLoaddt").Value.ToString + "_*.txt"
Filepath = Dts.Variables("User::vSrcFolder").Value.ToString
Dim di As DirectoryInfo = New DirectoryInfo(Filepath)
Dim fi As FileInfo() = di.GetFiles(Filename)
Dim DestTab As DataTable
DestTab = New DataTable("DestinationTable")
Dim column As DataColumn = New DataColumn("Dest")
column.DataType = System.Type.GetType("System.String")
DestTab.Columns.Add(column)
DestTab.Rows.Add("TM_xxx_ONLINE")
DestTab.Rows.Add("TM_xxx_RETAIL")
DestTab.Rows.Add("TM_xxx_TELESALES")
DestTab.Rows.Add("TM_xxx_DAILY_DEVICE")
Dim SrcTab As DataTable
SrcTab = New DataTable("SourceTable")
Dim column1 As DataColumn = New DataColumn("Source")
column1.DataType = System.Type.GetType("System.String")
Dim column2 As DataColumn = New DataColumn("FileExists")
column2.DataType = System.Type.GetType("System.String")
SrcTab.Columns.Add(column1)
SrcTab.Columns.Add(column2)
For i = 0 To fi.Length - 1
SrcTab.Rows.Add(Left(fi.GetValue(i).ToString, Len(fi.GetValue(i).ToString) - 20), "Exists")
Next
Dim query =
From a In DestTab
Group Join b In SrcTab
On a.Field(Of String)("dest") Equals b.Field(Of String)("Source")
Into Group
Let b = Group.FirstOrDefault
Select dest = a.Field(Of String)("dest"), FileExists = If(b Is Nothing, "Missing", b.Field(Of String)("FileExists"))
The biggest challenge and I am not able to understand how to use the variable "query" in "Dim query". While examples in the net and able to use it as a datarow, copytodatatable and other. I can only see tostring,equals and things like that.
My objective is to read files in a folder join it with "Destinationtable" and find the missing ones.
The codes written below are the one right after the select statement
Error Screenshots
I think you should use
For each line in query.ToList()
Dim drRow as DataRow
drRow = MT.NewRow
drRow("Filename") = line.Item(0)
MT.Rows.Add(drRow)
Next
Instead of
For each line in query
MT.Rows.Add(query)
Next
Sorry if this is long. I had to explain everything.
I have the following three moduels:
1. CreateDemoMap
2. CreateDemoTable
3. Update
The CreateDemoMap will go through a table and get the location (Top and Left), size (Width and Length), Name, Rotation and title of shapes and place them on the screen. Basically, it will build a map. This is the main part of my code:
For i = 2 To endNum 'input the number manual for now
Top = Workbooks("Reference").Worksheets("Directory").Cells(i, 2)
Left = Workbooks("Reference").Worksheets("Directory").Cells(i, 3)
Width = Workbooks("Reference").Worksheets("Directory").Cells(i, 4)
Height = Workbooks("Reference").Worksheets("Directory").Cells(i, 5)
Name = Workbooks("Reference").Worksheets("Directory").Cells(i, 6)
Rotation = Workbooks("Reference").Worksheets("Directory").Cells(i, 7)
Title = Workbooks("Reference").Worksheets("Directory").Cells(i, 8)
Set sh = w.Shapes.AddShape(msoShapeRectangle, Left, Top, Width, Height)
sh.Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Rotation = Rotation
Selection.ShapeRange.Title = Title
Selection.ShapeRange.Name = Name
Next i
Here is a screenshot of my table and the map:
Map & Table
Next, I thought it would be cool to go through the shape range array and get the properties of each objects. Also, it enabled me get the shape ID.
Sub Test1()
Dim Top As Long
Dim Left As Long
Dim Width As Long
Dim Height As Long
Dim ID As String
Dim Name As String
Dim Rotation As String
Dim Title As String
Dim sh As Object
Dim endNum As Integer
CreateSheet ("DemoTable")
totalShape = 90
rnr = 2
IndexNum = 0
Worksheets("DemoMap").Activate
For Each shp In ActiveSheet.Shapes
IndexNum = IndexNum + 1
Worksheets("DemoTable").Cells(rnr, 1) = IndexNum
Worksheets("DemoTable").Cells(rnr, 2) = shp.Top
Worksheets("DemoTable").Cells(rnr, 3) = shp.Left
Worksheets("DemoTable").Cells(rnr, 4) = shp.Width
Worksheets("DemoTable").Cells(rnr, 5) = shp.Height
Worksheets("DemoTable").Cells(rnr, 6) = shp.ID
Worksheets("DemoTable").Cells(rnr, 7) = shp.Name
Worksheets("DemoTable").Cells(rnr, 9) = shp.Rotation
Worksheets("DemoTable").Cells(rnr, 10) = shp.Title
Worksheets("DemoTable").Cells(rnr, 11) = shp.Type
rnr = rnr + 1
Next shp
End Sub
This is how it looks like:
Shape Table
Objectives:
A. update the Top, Left, and rotation of the shapes if the objects were moved or rotated.
B. Be able to account for deleted and added shapes
Solutions:
A. Since there wasn't an event listener in VBA, I decided to let the user move the objects however she want and then click a button that would update the table you saw earlier. Here is my code for this sub:
Sub UpdateShapes()
Dim Top As Long
Dim Left As Long
Dim Width As Long
Dim Height As Long
Dim ID As String
Dim Name As String
Dim Rotation As String
Dim Title As String
Dim sh As Object
Dim endNum As Integer
Dim Changes As Integer
Dim JSBChanges As Integer
Dim OneChanges As Integer
Dim TwoChanges As Integer
Dim ThreeChanges As Integer
Dim M1Changes As Integer
Dim M2Changes As Integer
Dim Deleted As Integer
Dim myDoc As Worksheet
Dim ShapeNum As Integer
Dim ShapeIndex As Integer
JSBChanges = 0
OneChanges = 0
TwoChanges = 0
ThreeChanges = 0
M1Changes = 0
M2Changes = 0
Deleted = 0
Set myDoc = Workbooks("Reference").Worksheets("DemoMap")
ShapeNum = myDoc.Shapes.Count
Debug.Print ("ShapeNum is: " & ShapeNum)
Workbooks("Reference").Worksheets("DemoMap").Activate
TableIndex = 2
ShapeIndex = 1
While (TableIndex <= (ShapeNum + 1))
Changes = 0
If(Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 6) = myDoc.Shapes.Range(ShapeIndex).ID) Then
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 2) <> myDoc.Shapes.Range(ShapeIndex).Top) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 2) = myDoc.Shapes.Range(ShapeIndex).Top
Changes = Changes + 1
End If
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 3) <> myDoc.Shapes.Range(ShapeIndex).Left) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 3) = myDoc.Shapes.Range(ShapeIndex).Left
Changes = Changes + 1
End If
If (Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 9) <> myDoc.Shapes.Range(ShapeIndex).Rotation) Then
Workbooks("Reference").Worksheets("DemoTable").Cells(TableIndex, 9) = myDoc.Shapes.Range(ShapeIndex).Rotation
Changes = Changes + 1
End If
If (Changes >= 1) Then
With myDoc.Shapes.Range(ShapeIndex).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Select Case (myDoc.Shapes.Range(ShapeIndex).Title)
Case "JSB"
JSBChanges = JSBChanges + 1
Case "1"
OneChanges = OneChanges + 1
Case "2"
TwoChanges = TwoChanges + 1
Case "3"
ThreeChanges = ThreeChanges + 1
Case "M1"
M1Changes = M1Changes + 1
Case "M2"
M2Changes = M2Changes + 1
End Select
End If
Else
Deleted = Deleted + 1
Workbooks("Reference").Worksheets("DemoTable").Rows(TableIndex).Interior.ColorIndex = 3
Workbooks("Reference").Worksheets("DemoTable").Rows(TableIndex).Font.ColorIndex = 2
ActiveWorkbook.Save
ShapeIndex = ShapeIndex - 1
End If
TableIndex = TableIndex + 1
ShapeIndex = ShapeIndex + 1
ShapeNum = myDoc.Shapes.Count
Wend
MsgBox ("JSBChanges: " & JSBChanges)
MsgBox ("OneChanges: " & OneChanges)
MsgBox ("TwoChanges: " & TwoChanges)
MsgBox ("ThreeChanges: " & ThreeChanges)
MsgBox ("M1Changes: " & M1Changes)
MsgBox ("M2Changes: " & M2Changes)
MsgBox ("Deleted: " & Deleted)
End Sub
Let's assume no shape has been added or deleted, which means the shaperange array should have the same number of objects. Thru. trail and error, I also discovered that the array elements won't move around and will stay still if you move your objects around. So, as you see, the code will compare the elements inside the DemoTable I just created with the elements inside the shaperange array. I can verify that this works if I start move things around. It will successfully update the Top and Left properties of the shapes that have been displaced.
Problem/Challenge/Issue:
Then I expanded the code, so it would identify if a shape has been deleted. As you see in my code, the fourth row in my table (Table Index = 4) should be the same (thus have the same shape ID) as the third element in the ShapeRange array. However if the third shape is deleted, the array get shrunk, which means the third element in the new (updated automaically) shapeRange array is the fourth element in the old array. This is useful, because then you can use this to figure out if a shape has been deleted or not. If the ID associated with TabeIndex = 4 is the same as Shape Index = 3, then that means that the object described by TableIndex = 4 has been deleted and the Shape associate with Shape Index = 3 should be the same as the one referenced by Table Index = 5 (the next shape). That's why, I added ShapeIndex = ShapeIndex - 1.
Make the story short, this works sometimes, but the other times it's not accurate. Last night I deleted 20 shapes and ran the sub. It told me that 17 objects were deleted. I spend hours looking the results and debugging the code, but found nothing. This evening, I ran the code again after deleting 15 objects. Here is my updated table:
Updated Demo Table
Those red lines mean that that row (particular shape) has been deleted. In this case, I deleted 15 shapes, but it only shows that only 12 shapes have been deleted. Obviously this not right. As I said earlier, it happened last night too. It's not consistent at all. To prove this, I used a similar code as my CreateDemMap sub. Basically, it goes through each objects in the worksheet and make a table just like before. If everything would've gone right, this table should be exactly the same as my Demo Table (assuming if I delete those red rows). It's NOT!
New Table For Checking
The new table I extracted from the ShapeRange array tells me that there are 70 shapes in the array (15 were deleted which is the correct number), but in my DemoTable, only 12 rows were highlighted as red. Why is this happening? Last night, I deleted a particular shape with a specific shape ID. By doing this, I was sure that that shape object would not be in the ShapeRange Array. However, when I was debugging, I realized that wasn't the case. The object was gone from my screen, but its shape ID (and consequently the shape itself) was still in the ShapeRange Array. Why is VBA Excel acting like this? Can someone help me please?
It's really hard to understand all your code - but I think your problem is because you're ending your loop too early. It runs until ShapeNum which is the number of shapes you have in your sheet. When you delete some shapes, this number is lower than the number of entries in your table and the last entries in the table are not checked.
I am inserting values in datagrid from MS-SQL server. I got a text box from which i wanted to perform search operation , but the thing is i haven't used data set.
the question is How do i search for values in datagrid without using data set in vb.net.
Here is my code fr filling up data grid view.
dim i as integer = 0
con.ConnectionString = "Data Source=MY_CONNECTION_STRING "
Dim cmd As New SqlCommand("selct ID, Name From tbl_name where 1=1 Order by Name ASC", con)
con.Open()
' Execute Query
Dim reader As SqlDataReader = cmd.ExecuteReader()
' Try
While reader.Read()
DataGridView10.Rows.Insert(i, New String() {reader(0), reader(1).ToString})
i = i + 1
End While
You can put this in a click event per say...
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
Dim intIndex As Integer = SearchGrid(TextBox1.Text, 0) 'Change the 0 to what column you want to search for
DataGridView1.Rows(intIndex).Selected = True 'This will select the row...'
DataGridView1.CurrentCell = DataGridView1.Rows(intIndex).Cells(0) 'This ensures that the arrow will move if you have row headers visible. In order to select the cell change the zero to the column your searching to match up top
End Sub
Here's the function...
Private Function SearchGrid(ByVal strItem As String, ByVal intColumn As Integer) As Integer
Dim intIndex As Integer = 0
For i As Integer = 0 To DataGridView1.Rows.Count - 1
If DataGridView1.Rows(i).Cells(intColumn).Value.ToString.Contains(strItem) Then 'Or change "Contains" to "Equals"
intIndex = i
Exit For
End If
Next
Return intIndex
End Function
This will work great for you and a great start, happy coding!
P.S. Make sure to change the datagridview name to reflect yours...