Visual basic matrices rotation - vb.net

I made a square using 2 1 by 4 matrices, however now I want to rotate it by 45 degrees.
This is the code for the square (which works fine):
Dim m(1, 4) As Single
Dim n(1, 4) As Single
Dim formGraphics As System.Drawing.Graphics = Me.CreateGraphics()
Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
formGraphics.DrawLine(myPen, m(1, 1), m(1, 2), n(1, 4), n(1, 3))
formGraphics.DrawLine(myPen, n(1, 1), n(1, 3), m(1, 4), m(1, 3))
formGraphics.DrawLine(myPen, n(1, 2), n(1, 4), m(1, 2), m(1, 1))
formGraphics.DrawLine(myPen, n(1, 3), n(1, 3), m(1, 3), m(1, 1))
myPen.Dispose()
formGraphics.Dispose()
However when I try and turn it by 45 degrees I just cannot seem to get it right and I have no idea what I'm doing wrong or how to fix it. Code so far:
Dim b(1, 4) As Single
Dim c(1, 4) As Single
Dim A(2, 2) As Single
Dim radians As Double
Dim degrees As Double
degrees = 45
radians = degrees * ((2 * PI) / 360)
A(1, 1) = Cos(radians)
A(1, 2) = -Sin(radians)
A(2, 1) = Sin(radians)
A(2, 2) = Cos(radians)
c(1, 1) = (A(1, 1) * m(1, 2)) + (A(1, 2) * n(1, 2))
c(1, 2) = (A(1, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
c(1, 3) = (A(1, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
c(1, 4) = (A(1, 1) * m(1, 2)) + (A(1, 2) * n(1, 2))
b(1, 1) = (A(2, 1) * m(1, 2)) + (A(2, 2) * n(1, 2))
b(1, 2) = (A(2, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
b(1, 3) = (A(2, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
b(1, 4) = (A(2, 1) * m(1, 4)) + (A(2, 2) * n(1, 4))
Dim formGraphics As System.Drawing.Graphics = Me.CreateGraphics()
Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
formGraphics.DrawLine(myPen, b(1, 3), b(1, 4), c(1, 4), c(1, 4))
formGraphics.DrawLine(myPen, c(1, 4), c(1, 2), b(1, 4), b(1, 4))
formGraphics.DrawLine(myPen, b(1, 1), c(1, 2), b(1, 4), b(1, 4))
formGraphics.DrawLine(myPen, c(1, 4), c(1, 1), b(1, 4), b(1, 2))
myPen.Dispose()
formGraphics.Dispose()

Related

Excel VBA to for inputbox to select sheets to forma

I have a code below that needs to be tweaked, as I want to be able to enter my sheet name in an input box and have it reformat the sheet and output next to the sheet I select.
See formula I attempted but failed.
Sub Chart()
Dim wb As Workbook
Dim wsRaw As Worksheet, wsResult As Worksheet
Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte
Dim Result As String
Result = InputBox("Provide a sheet name.")
Workbooks(wb).Sheets(Result).Select
Set wb = ThisWorkbook
Set wsRaw = Application.ActiveSheet
Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.count))
iRow = 2
iResultRow = 2
Do Until wsRaw.Cells(iRow, 1) = Empty
wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow, 5) = "Lender"
wsResult.Cells(iResultRow + 1, 5) = "All"
wsResult.Cells(iResultRow + 2, 5) = "Percent"
iRawCol = 5
iCol = 6
Do Until iCol = 46
wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9)
wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol)
wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1)
wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2)
iCol = iCol + 1
iRawCol = iRawCol + 3
Loop
iResultRow = iResultRow + 3
iRow = iRow + 1
Loop
Sheets("Macros").Select
End Sub
Sub Chart()
Dim wb As Workbook
Dim wsRaw As Worksheet, wsResult As Worksheet
Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte
Dim Result As Worksheet, RangeResult As Range
Set wb = ThisWorkbook
Set ResultRange = Application.InputBox("Provide a sheet name.", Type:=8)
Set Result = ResultRange.Parent
wb.Result.Select
Set wsRaw = Application.ActiveSheet
Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.Count))
iRow = 2
iResultRow = 2
Do Until wsRaw.Cells(iRow, 1) = Empty
wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow, 5) = "Lender"
wsResult.Cells(iResultRow + 1, 5) = "All"
wsResult.Cells(iResultRow + 2, 5) = "Percent"
iRawCol = 5
iCol = 6
Do Until iCol = 46
wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9)
wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol)
wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1)
wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2)
iCol = iCol + 1
iRawCol = iRawCol + 3
Loop
iResultRow = iResultRow + 3
iRow = iRow + 1
Loop
Sheets("Macros").Select
End Sub

How to merge a number of loops into one in a VBA program?

I am fairly inexperienced with VBA, and I can't figure out how to make this loop. I set up 4 separate statements and it works this way, but I want to make this one statement.
i = 1
Do Until i > combos
Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = Range(Cells(3, 4), Cells(3, 4))
i = i + TErepeat
Loop
w = 4
Do Until w > combos
Range(Cells(w, 10), Cells(w + Defrepeat - 1, 10)) = Range(Cells(4, 4), Cells(4, 4))
w = w + TErepeat
Loop
p = 7
Do Until p > combos
Range(Cells(p, 10), Cells(p + Defrepeat - 1, 10)) = Range(Cells(5, 4), Cells(5, 4))
p = p + TErepeat
Loop
k = 10
Do Until k > combos
Range(Cells(k, 10), Cells(k + Defrepeat - 1, 10)) = Range(Cells(6, 4), Cells(6, 4))
k = k + TErepeat
Loop
Dim c As Range, i As Long, n As Long
Set c = Cells(3, 4)
For n = 1 To 10 Step 3
i = n
Do Until i > combos
Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = c.Value
i = i + TErepeat
Loop
Set c = c.Offset(1, 0)
Next n

VBA List to be put in sticker format

I have a list of data which needs to be printed out on stickers (imagine the Avery kind). I'm having trouble coming up with the code that will produce the desired result:
My code thus far is:
With wsEtiketten
' erase old data
.Cells.Clear
' enter new data
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
For j = 0 To 4
r.Copy .Cells(4, 2).Offset(i * 5, j * 5)
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Ordernr
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Count
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next j
Next i
End With
The information which is tied to it is simply repeated across the row. I need i to change every time the field is offset. How can I do that? I'm sure this is probably programming kindergarden stuff but I'm not getting it.
Thanks!
Maybe an answer with an unexpected twist. You can use an Excel table in combination with Word to get the result you want as well. This is standard Office functionality:
http://support.microsoft.com/kb/318117/en
or in German:
http://support.microsoft.com/kb/318117/de
Ok. I managed to come up with an answer within Excel. Once I had it, it was obvious.
Here goes:
With wsEtiketten
' Alte Daten werden gelöscht
.Cells.Clear
' Neue Daten werden eingelesen
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
r.Copy .Cells(4, 2).Offset(WorksheetFunction.RoundDown(i / 5, 0) * 5, ((i + 5) Mod 5) * 5)
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Bestellnummer
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Anzahl
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next i
End With

Sending excel objects to subroutines

As it is right now I have a bit of code that kind of looks like this (a little paraphrased but Im sure you get the idea)
If ComboBox1.SelectedIndex = 1 Then
swEV2.Stop()
If ComboBox3.SelectedIndex = 0 Then
xlWorkSheet202.Activate()
xlWorkSheet202.Cells((AT + 2), 3) = TextBox1.Text
xlWorkSheet202.Cells((AT + 3), 2) = "PSS (kBs)"
xlWorkSheet202.Cells((AT + 3), 3) = "USS (kBs)"
xlWorkSheet202.Cells((AT + 3), 4) = "User %"
xlWorkSheet202.Cells((AT + 3), 5) = "Kernel %"
xlWorkSheet202.Cells((AT + 3), 6) = "Total %"
xlWorkSheet202.Cells((AT + 4), 1) = "Min:"
xlWorkSheet202.Cells((AT + 5), 1) = "Max:"
xlWorkSheet202.Cells((AT + 6), 1) = "Average:"
xlWorkSheet202.Cells((AT + 7), 1) = "Median:"
xlWorkSheet202.Cells((AT + 8), 1) = "Stan Dev:"
ElseIf ComboBox3.SelectedIndex = 2 Then
xlWorkSheet204.Cells((WT + 2), 3) = TextBox1.Text
xlWorkSheet204.Cells((WT + 3), 2) = "PSS (kBs)"
xlWorkSheet204.Cells((WT + 3), 3) = "USS (kBs)"
xlWorkSheet204.Cells((WT + 3), 4) = "User %"
xlWorkSheet204.Cells((WT + 3), 5) = "Kernel %"
xlWorkSheet204.Cells((WT + 3), 6) = "Total %"
xlWorkSheet204.Cells((WT + 4), 1) = "Min:"
xlWorkSheet204.Cells((WT + 5), 1) = "Max:"
xlWorkSheet204.Cells((WT + 6), 1) = "Average:"
xlWorkSheet204.Cells((WT + 7), 1) = "Median:"
xlWorkSheet204.Cells((WT + 8), 1) = "Stan Dev:"
This goes on 3 more times in a few different places... So now I am trying to refactor the code to make it cleaner and shorter.
What I would like to do is this:
If ComboBox1.SelectedIndex = 1 Then
swEV2.Stop()
If ComboBox3.SelectedIndex = 0 Then
Excelupdate(xlWorkSheet203, AT)
ElseIf ComboBox3.SelectedIndex = 2 Then
Excelupdate(xlWorkSheet204, WT)
Private sub ExcelUpdate(byref worksheet as object, byref update as string)
worksheet.Activate()
worksheet.Cells((update + 2), 3) = TextBox1.Text
worksheet.Cells((update + 3), 2) = "PSS (kBs)"
worksheet.Cells((update + 3), 3) = "USS (kBs)"
worksheet.Cells((update + 3), 4) = "User %"
worksheet.Cells((update + 3), 5) = "Kernel %"
worksheet.Cells((update + 3), 6) = "Total %"
worksheet.Cells((update + 4), 1) = "Min:"
worksheet.Cells((update + 5), 1) = "Max:"
worksheet.Cells((update + 6), 1) = "Average:"
worksheet.Cells((update + 7), 1) = "Median:"
worksheet.Cells((update + 8), 1) = "Stan Dev:"
end sub
I thought for sure the above would work but it still seems that I am missing something, when I open the excel sheet nothing was printed. This would cut down the lines of code that I have in half easily, so I would love to find a solution for this
Thanks Guys
.......................................................
Edit (Sorry those comment boxes are terrible for writing anything)
.......................................................
alright I tried changing these lines of code:
If ComboBox2.SelectedIndex = 1 Then
If ComboBox3.SelectedIndex = 0 Then
ExcelUpdate(xlWorkSheet202, AT, CDbl(Pvalue), CDbl(uvalue), CDbl(UserRx.Match(line).Value), CDbl(KernelRx.Match(line).Value))
ElseIf ComboBox3.SelectedIndex = 1 Then
ExcelUpdate(xlWorkSheet203, GT, CDbl(Pvalue), CDbl(uvalue), CDbl(UserRx.Match(line).Value), CDbl(KernelRx.Match(line).Value))
ElseIf ComboBox3.SelectedIndex = 2 Then
ExcelUpdate(xlWorkSheet204, WT, CDbl(Pvalue), CDbl(uvalue), CDbl(UserRx.Match(line).Value), CDbl(KernelRx.Match(line).Value))
ElseIf ComboBox3.SelectedIndex = 3 Then
ExcelUpdate(xlWorkSheet205, OT, CDbl(Pvalue), CDbl(uvalue), CDbl(UserRx.Match(line).Value), CDbl(KernelRx.Match(line).Value))
End If
End If
Private Sub ExcelUpdate(ByVal Sheet As Object, ByVal update As Integer, ByVal pval As Double, ByVal uval As Double, ByVal user As Double, ByVal kernel As Double)
update = update + 1
Sheet.cells(update, 1) = timenow
Sheet.cells(update, 2) = pval
Sheet.cells(update, 3) = uval
Sheet.cells(update, 4) = user
Sheet.cells(update, 5) = kernel
Sheet.cells(update, 6) = cdbl(kernel + User)
end sub
But the excel sheets still do not update with the new information. Is there anything else im missing?
I would check/change a couple of things:
1) Change the ByRefs in the function to ByVal. You don't need to update the reference to the worksheet or modify the string, so ByRef is not need.
2) Determine the data type of the update parameter. You are mixing operation and types, which could result in an incorrect cells reference.
If the goal of the cell reference is:
worksheet.Cells(("A2"), 3)
then you should change your code to:
worksheet.Cells((update & "2"), 3)
If the goal of the cell reference is:
worksheet.Cells((12), 3)
then you should change the update parameter type:
update as integer

For Loops in VB

I have a 5 by 5 matrix I want to populate and I would like to simplify this into for loops.
As I understand, I would need 2 for loops to complete this task?
I am still very new to VB hope you could understand
Dim x(4, 4) As Char
x(0, 0) = Mid(key, 1, 1)
x(0, 1) = Mid(key, 2, 1)
x(0, 2) = Mid(key, 3, 1)
x(0, 3) = Mid(key, 4, 1)
x(0, 4) = Mid(key, 5, 1)
x(1, 0) = Mid(key, 6, 1)
x(1, 1) = Mid(key, 7, 1)
....
x(4, 4) = Mid(key, 25, 1)
Try something like this:
Dim x As Integer
Dim y As Integer
Dim myMatrix(4, 4) As Char
For x = 0 To 4
For y = 0 To 4
myMatrix(x, y) = Mid(key, (x * 5) + y + 1, 1)
Next
Next