How can i get a var value from a sub by calling it in other sub ? like
Sub test()
Dim a As Integer
a = 1
End Sub
Sub testshow()
MessageBox.Show(test.a)
End Sub
In VBA (which your tag states) you need to change Sub into Function which will be:
Function test()
Dim a As Integer
a = 1
test = a
End Function
Sub testshow()
MsgBox test
End Sub
EDIT after comment: If you using more then one variable then:
Function test(whichVar)
Dim a As Integer
If whichVar = 1 then
a = 100
ElseIf whichVar = 2 Then
a = 200
'etc...
End if
test = a
End Function
Sub testshow()
MsgBox test(2) 'will give you 200
End Sub
Related
I'm trying to get data from a DGV grid onto specific tags, and so far it has been working great. But an update moved the tags positions in the DGV so Rows(x) does not equal the tags I'm moving data into anymore.
Is it possible to do a search like the one I'm doing in Cells("Val") but in the Rows("") instead?
Actually I want it to be something like this Rows("TagIndex = 5") etc.
A full line of code would then be:
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
but is this possible.
Row 12 & 13 are switched when logging
dgvDataFLT = dgvDataFloating
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows(10).Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows(9).Cells("Val").Value
FrontFree = dgvDataFlt.Rows(8).Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows(7).Cells("Val").Value
PalletStatus = dgvDataFlt.Rows(6).Cells("Val").Value
HopperStatus = dgvDataFlt.Rows(5).Cells("Val").Value
PowerStatus = dgvDataFlt.Rows(4).Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows(3).Cells("Val").Value
NomCycTime = dgvDataFlt.Rows(2).Cells("Val").Value
AutoStart = dgvDataFlt.Rows(1).Cells("Val").Value
MachineNo = dgvDataFlt.Rows(0).Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I want the code to look/work something like this:
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows("TagIndex = 10").Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows("TagIndex = 9").Cells("Val").Value
FrontFree = dgvDataFlt.Rows("TagIndex = 8").Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows("TagIndex = 7").Cells("Val").Value
PalletStatus = dgvDataFlt.Rows("TagIndex = 6").Cells("Val").Value
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
PowerStatus = dgvDataFlt.Rows("TagIndex = 4").Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows("TagIndex = 3").Cells("Val").Value
NomCycTime = dgvDataFlt.Rows("TagIndex = 2").Cells("Val").Value
AutoStart = dgvDataFlt.Rows("TagIndex = 1").Cells("Val").Value
MachineNo = dgvDataFlt.Rows("TagIndex = 0").Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I would suggest adding a class and then inheriting the DataGridView control into that class. I have made a quick little example of this and the code works, but to get it to work you will have to perform a few steps:
(1) If you don't already have a windows forms application to test this then,
make a new one.
(2) Create class named KeyedDataGridView
(3) Copy and Paste the following Code into KeyedDataGridView class
(4) Rebuild your Project
(5) Drag and Drop new component onto your windows Form.
NOTE: This class is limited, but should still be able to do what you require of it.
Finally, if you need any help then, please leave a comment and will try to get to it when I can.
Option Explicit On
Public Class KeyedDataGridView
Inherits Windows.Forms.DataGridView
Dim _Rows As KeyedDataRows
Public Shadows Property Rows As KeyedDataRows
Get
Return _Rows
End Get
Set(value As KeyedDataRows)
_Rows = value
End Set
End Property
Public Sub New()
Dim strName As String
strName = Me.Name
strName = MyBase.Name
_Rows = New KeyedDataRows(Me)
_Rows.Rows = MyBase.Rows
End Sub
Protected Overrides Sub Finalize()
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
Public Class KeyedDataRows
Inherits Windows.Forms.DataGridViewRowCollection
Dim _TagNames As Dictionary(Of String, Integer)
Dim _Rows As DataGridViewRowCollection
Dim _Cells As Dictionary(Of String, DataGridViewCellCollection)
Dim dgv As DataGridView
Default Public Overloads ReadOnly Property Item(strTagName As String) As DataGridViewRow
Get
Return _Rows.Item(Me.IndexFromName(strTagName))
End Get
End Property
Protected Friend Property Rows As DataGridViewRowCollection
Get
Return _Rows
End Get
Set(value As DataGridViewRowCollection)
_Rows = value
End Set
End Property
Public Property TagName(index As Integer) As String
Get
Return CStr(_TagNames.Item(index))
End Get
Set(value As String)
_TagNames.Item(index) = value
End Set
End Property
Public Sub New(tmp As DataGridView)
MyBase.New(tmp)
dgv = tmp
_TagNames = New Dictionary(Of String, Integer)
_Cells = New Dictionary(Of String, DataGridViewCellCollection)
End Sub
Public Shadows Sub Add(strTagName As String)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add()
End Sub
Public Shadows Sub Add(strTagName As String, dataGridViewRow As DataGridViewRow)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add(dataGridViewRow)
End Sub
Public Shadows Sub Add(count As Integer, strTagNames() As String)
Dim intI As Integer
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
For intI = 0 To (count - 1)
_TagNames.Add(strTagNames(intI), intCurRow)
_Rows.Add()
intCurRow = _Rows.Count - 1
Next intI
End Sub
Public Property IndexFromName(strTagName As String) As Integer
Get
If _TagNames.Count > 0 Then
If _TagNames.ContainsKey(strTagName) Then
Return _TagNames.Item(strTagName)
Else
Return -1
End If
Else
Return -1
End If
End Get
Set(value As Integer)
_TagNames.Add(strTagName, value)
End Set
End Property
Public Overloads Sub RemoveAt(strTagName As String)
_Cells.Remove(strTagName)
_Rows.RemoveAt(IndexFromName(strTagName))
_TagNames.Remove(strTagName)
End Sub
Protected Overrides Sub Finalize()
_TagNames.Clear()
_TagNames = Nothing
_Cells.Clear()
_Rows.Clear()
_Cells = Nothing
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
I also, added the following buttons to a windows form to test the code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
With KeyedDataGridView1
.Rows.Add("Tag Test 1")
.Rows.Add("Tag Test 2")
.Rows.Add("Tag Test 3")
.Rows.Add("Tag Test 4")
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
MsgBox(KeyedDataGridView1.Rows("Tag Test 3").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 2").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 1").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(2).Value)
End Sub
I've tried finding a solution to this problem but have been unable to.
In generic form:
Module1
Sub Source()
Call Module2.Run
End Sub
Module2
Sub Run()
Value = 10
Some code which uses Value as input
End Sub
What I want to be able to do is to be able to define multiple Values in Module1 and then run Module2.Run() with each value.
Module1
Sub Source()
Value = 10, 20, 30
Call Module2.Run (10)
Call Module2.Run (20)
Call Module2.Run (30)
End Sub
Module2
Sub Run()
Value = Input from Module1.Source()
Some code which uses Value as input
End Sub
Or something along these lines. Any input would be greatly appreciated.
You can pass parameters through arguments like so
Sub Sub1 ()
Dim myVal as Long
myVal = 1000
Sub2 (myVal) 'The "Call" is not necessary
End Sub
Sub Sub2 (myVal as Long) 'This sub requires an input to run (myVal)
MsgBox myVal
End Sub
You can create an array, fill it and pass as an argument.
Avoid using names like Source and Run which are already used by Excel;.
Option Explicit
Sub Sour()
Dim arr_1d() As Variant
arr_1d = Array("val1", "val2", "val3")
Dest arr_1d
End Sub
Sub Dest(arr_1d() As Variant)
Dim y As Long
For y = LBound(arr_1d) To UBound(arr_1d)
Debug.Print arr_1d(y)
Next
End Sub
I'm trying to create a function or sub to create a report in VBA Excel. I want the user to Enter two dates into two separate text boxes. Then when the submit button is clicked it checks if the text boxes are empty or not then if they aren't it preforms the CreateReport() Sub or function which creates a new sheet and appends data to it. Here is my code:
Userform2:
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Submit_Click()
If UserForm2.Date1.Value = "" & UserForm2.Date2.Value = "" Then
Value1 = UserForm2.Date1.Value
Value2 = UserForm2.Date2.Value
CreateReport(Value1,Value2)
End If
End Sub
Private Sub UserForm_Initialize()
Date1.SetFocus
Dim Value1 As String
Dim Value2 As String
End Sub
Module1:
Option Explicit
Public Function CreateSheet(Name1 As String, Name2 As String)
Dim WS As Worksheet
Dim FullName As String
FullName = Name1 & "-" & Name2
Set WS = Sheets.Add.Name = FullName
End Function
Public Sub CreateReport(Date1 As String, Date2 As String)
End Sub
You're calling CreateReport when there are no dates entered...
Also
CreateReport(Value1,Value2)
should be
CreateReport Value1, Value2
you don't use parentheses unless you're calling a function or using the Call keyword.
And
Set WS = Sheets.Add.Name = FullName
should probably be
Set WS = Sheets.Add()
WS.Name = FullName
How can I use a vairable from Sub Main, in another sub.
Example
Sub Main()
Dim x As Long
End Sub
Sub Test() Dim y = x End Sub
Is this possible on vb.net
You could pass it to a function and return it again:
Sub Main()
Dim x As Long
' Give x a value
x = Test(x)
' Do something else with x
End Sub
Function Test(x As Long) As Long
' Do something with x
Return x
End Sub
Or declare it as a global variable:
Dim x As Long
Sub Main()
' Do something with x
End Sub
Sub Test()
Dim y = x ' Do something else
End Sub
There is a very easy way to do this.
Declare the value out of all the Subs on the top.
Public Class Form 1
Dim x As Long
Private Sub Main ()
End Sub
Private Sub Test ()
End Sub
End Class
And then write y = x on whichever Sub you want!
The following code creates a circular reference for each element in the collection. Is the code in the UserForm_Terminate routine sufficient to tear down the relationships to allow the memory to be released? Or is there a requirement to use pointers and weak references?
If so/not what is the best method for testing whether the objects have been released?
Userform Code:
Option Explicit
Implements IBtnClick
Dim coll As Collection
Private Sub UserForm_Initialize()
Dim x As Long
Dim e As CBtnEvents
Set coll = New Collection
For x = 1 To 5
Set e = New CBtnEvents
Set e.btn = Me.Controls.Add("Forms.CommandButton.1")
e.ID = x
e.Register Me
With e.btn
.Height = 30
.Width = 30
.Top = 10
.Left = .Width * x
End With
coll.Add e
Next x
End Sub
Private Sub UserForm_Terminate()
Dim itm
For Each itm In coll
msgbox itm.ID
itm.Unregister
Next itm
End Sub
Private Sub IBtnClick_click(ID As Long)
MsgBox ID
End Sub
IBtnClick Code:
Public Sub click(ID As Long)
End Sub
CBtnEvents Code:
Private WithEvents p_btn As MSForms.CommandButton
Private p_ID As Long
Private click As IBtnClick
Public Property Set btn(value As MSForms.CommandButton)
Set p_btn = value
End Property
Public Property Get btn() As MSForms.CommandButton
Set btn = p_btn
End Property
Public Sub Register(value As IBtnClick)
Set click = value
End Sub
Public Sub Unregister()
Set click = Nothing
End Sub
Private Sub p_btn_Click()
click.click p_ID
End Sub
Public Property Get ID() As Long
ID = p_ID
End Property
Public Property Let ID(ByVal lID As Long)
p_ID = lID
End Property
Private Sub Class_Terminate()
MsgBox p_ID
End Sub
I have included the VB6 tag as I think the question applies equally, but I am using Excel VBA.
This is how we (manually) keep our instance book-keeping collection:
In every class/form/control we place something like this
Option Explicit
DefObj A-Z
Private Const MODULE_NAME As String = "cTransStub"
'=========================================================================
' Constants and member variables
'=========================================================================
' Consts here
' Vars here
#If DebugMode Then
Private m_sDebugID As String
#End If
' Props here
' Methods here
'=========================================================================
' Base class events
'=========================================================================
#If DebugMode Then
Private Sub Class_Initialize()
DebugInstanceInit MODULE_NAME, m_sDebugID, Me
End Sub
Private Sub Class_Terminate()
DebugInstanceTerm MODULE_NAME, m_sDebugID
End Sub
#End If
Sample implementation of helper DebugInstanceInit/Term subs that populate DebugIDs collection:
Public Sub DebugInstanceInit(sModuleName As String, sDebugID As String, oObj As Object)
Dim sCount As String
Dim lObjPtr As Long
Dim sObjCtx As String
On Error Resume Next
sDebugID = sDebugID & GetDebugID()
If DebugIDs Is Nothing Then
Else
...
lObjPtr = ObjPtr(oObj)
DebugIDs.Add sDebugID & " " & LIB_NAME & "." & sModuleName & "|&H" & Hex(lObjPtr) & "|" & Format$(time, "hh:mm:ss") & "|" & sObjCtx & "|", "#" & sDebugID
End If
...
If Not DebugConsole Is Nothing Then
DebugConsole.RefreshConsole
End If
On Error GoTo 0
End Sub
Public Sub DebugInstanceTerm(sModuleName As String, sDebugID As String)
On Error Resume Next
If DebugIDs Is Nothing Then
Else
DebugIDs.Remove "#" & sDebugID
End If
...
If Not DebugIDs Is Nothing Then
If DebugIDs.Count = 0 Then
Debug.Print "DebugIDs collection is empty"; Timer
End If
End If
If Not DebugConsole Is Nothing Then
DebugConsole.RefreshConsole
End If
On Error GoTo 0
End Sub
Upon program termination we warn for any object leaking in DebugIDs collection.