Private Sub Command1_Click()
Dim contador As Integer
Dim tabla As TableDef
Dim columna As Field
Dim baseDeDatos As Database
Dim directorioDB As String
Set tabla = baseDeDatos.OpenTable("Empleados")
tabla.AddNew
tabla!Legajo = Text1.Text
tabla.AddNew
tabla!Nombre = Text2.Text
If Text3.Text > 19 And Text3.Text < 51 Then
tabla.AddNew
tabla!Edad = Text3.Text
Label4.Caption = "Terminado"
Else
Label4.Caption = "Registro no cargado. Rango de edad entre 20 y 50 años"
End If
tabla.Update
If contador = 10 Then
Command1.Caption = "Cargados 10 registros"
Else
contador = contador + 1
End If
End Function
Private Sub Form_Load()
Dim tabla As TableDef
Dim columna As Field
Dim baseDeDatos As Database
Dim directorioDB As String
Set archivo = New FileSystemObject
If Not archivo.FileExists("C:\Users\tam45949\Desktop\tp2programacion2.mdb") Then
Set baseDeDatos = DBEngine.Workspaces(0).CreateDatabase("C:\Users\tam45949\Desktop\tp2programacion2.mdb", dbLangSpanish)
End If
Set baseDeDatos = OpenDatabase("C:\Users\tam45949\Desktop\tp2programacion2.mdb")
Set tabla = baseDeDatos.CreateTableDef("Empleados")
Set columna1 = tabla.CreateField("Legajo", dbInteger)
tabla.Fields.Append (columna1)
Set columna2 = tabla.CreateField("Nombre", dbText, 30)
tabla.Fields.Append (columna2)
Set columna3 = tabla.CreateField("Edad", dbInteger)
tabla.Fields.Append (columna3)
baseDeDatos.TableDefs.Append tabla
End Sub
Private Sub Form_Terminate()
tabla.Close
baseDeDatos.Close
End Sub
Link to the library list
I don't know what is the problem with the code and i searched on the net a couple of hours and i still can't find se solution. The problem should be in the Addnew function, i guess there is a missing library.
Hope you can help me, i'm new with v b 6.0. Thanks!.
Probably you don't have a correct reference to DAO (or ADO), check in project references if you are able to use Microsoft Data Object (DAO) or ADO with recordset.
The method AddNew in general is the old way to work with recordsets and common in DAO code. I believe that you can move the code to use ADO and improve your statements with update , insert and delete and not using AddNew or Edit
Related
I have a little issue with WMI query.
I have to check if a certain property exists in a WMI query instance, the code i have done is:
Imports System.Management
Imports System.Management.Instrumentation
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim search_cpu As New ManagementObjectSearcher("SELECT * FROM Win32_Processor")
Dim info_cpu As ManagementObject '= Convert.ToUInt32("search_cpu")
Dim cpu_v As Integer
For Each info_cpu In search_cpu.Get()
If search_cpu.Get("caption") = True Then
cpu_v = "Caption"
Label1.Text = ("Name: " & info_cpu(cpu_v).ToString())
End If
Next
End Sub
End Class
Any help will be appreciated.
Thanks in advance
I managed to reproduce. The below code works allright for me and Label1 now displays:
Intel64 Family 6 Model 58 Stepping 9
Sub Main()
Dim search_cpu As New ManagementObjectSearcher("SELECT * FROM Win32_Processor")
Dim info_cpu As ManagementObject '= Convert.ToUInt32("search_cpu")
Dim caption As String
For Each info_cpu In search_cpu.Get()
caption = info_cpu("caption").ToString()
Next
Label1.Text = caption
if (string.isnullorempty(caption))
Label1.Text ="<does not exist>"
End Sub
Imports System.Data.OleDb
Imports System.Data
Partial Class _Default
Inherits System.Web.UI.Page
Protected Sub TextBox1(sender As Object, e As System.EventArgs) Handles TextBox1.TextChanged
Dim userid As String = TextBox1.Text
Dim params(1) As OleDbParameter
params(0) = New OleDbParameter("uid", TextBox1.Text)
params(1) = New OleDbParameter("up", TextBox2.Text)
Dim sql = "select * from user where userid=#uid and userpassword=#up"
Dim ds As DataSet = AccessHelper.ExecuteDataSet(sql, params)
If ds.Tables(0).Rows.Count = 1 Then
Session("userid") = TextBox1.Text
Else
Dim paramst(1) As OleDbParameter
paramst(0) = New OleDbParameter("tid", TextBox1.Text)
paramst(1) = New OleDbParameter("tp", TextBox2.Text)
Dim sqlt = "select * from teacher where teacherid=#tid and userpassword=#tp"
Dim dst As DataSet = AccessHelper.ExecuteDataSet(sqlt, paramst)
If dst.Tables(0).Rows.Count = 1 Then
Session("teacherid") = TextBox1.Text
End If
End If
End Sub
End Class
Can't really figure out why I get the errors (http://i.imgur.com/Zb2hBlo.png)
No idea what I'm doing really but it's a check to see if the login exists. Beforehand it was saying that textbox1/2 wasn't declared but now it's switched to this; either way it doesn't work and I don't know what to do.
I am successfully able to download the defects using the below code, but how to get the count of linked TCs with status 'Failed or Blocked' against each defect?
Sub GetDefectsByFilter()
On Error Resume Next
Dim a
Dim intIndex As Integer
Dim sngPercent As Single
Dim BugFactory, BugList, BgFilter
Dim Response As VbMsgBoxResult
Dim DefectID As String
If TDC Is Nothing Then ConnecttoQC
Set BugFactory = TDC.BugFactory
Set BgFilter = BugFactory.Filter
DefectID = frmDefectFilter.txtDefectID
BgFilter.Filter("BG_BUG_ID") = DefectID
Set BugList = BgFilter.NewList
Dim Bug, Row, Count As Integer
Count = 1
Row = 2
ActiveSheet.Cells(1, 1).Value = "Defect ID"
ActiveSheet.Cells(1, 2).Value = "Application"
ActiveSheet.Cells(1, 3).Value = "Status"
For Each Bug In BugList
ActiveSheet.Cells(Row, 1).Value = Bug.Field("BG_BUG_ID")
ActiveSheet.Cells(Row, 2).Value = Bug.Field("BG_USER_06")
ActiveSheet.Cells(Row, 3).Value = Bug.Field("BG_STATUS")
Row = Row + 1
Count = Count + 1
Next
frmDefectFilter.Hide
End Sub
Thanks #Roland. The below code snippet helped me.
Sub ViewLinks()
'------------------------------------------------------
' Output all bug links.
Dim BugF As BugFactory, bList As List
Dim aBug As Bug
Dim bugL As ILinkable, LinkList As List, linkF As LinkFactory
'tdc is the global TDConnection object.
Set BugF = tdc.BugFactory
Set bList = BugF.NewList("")
For Each aBug In bList
'Cast the Bug object to an ILinkable reference
' to get the link factory.
Set bugL = aBug
Set linkF = bugL.LinkFactory
Set LinkList = linkF.NewList("")
Dim SourceObj As Object, TargetObj As Object, InitObj As Object, lnk As Link
Debug.Print: Debug.Print "---------------------------------"
Debug.Print "Source Type"; Tab; "ID"; Tab; "Target Type"; _
Tab; "ID"; Tab; "Initiated by"
For Each lnk In LinkList
With lnk
Set SourceObj = .SourceEntity
Set TargetObj = .TargetEntity
Set InitObj = .LinkedByEntity
Debug.Print TypeName(SourceObj); Tab; CStr(SourceObj.ID); _
Tab; TypeName(TargetObj); Tab; CStr(TargetObj.ID); _
Tab; TypeName(InitObj); Spc(3); InitObj.ID
End With
Next lnk
Next aBug
End Sub
Can anyone tell me why the activeworksheet object MCWS is not being created by the following VB Script please? It is the code for a combobox in a mathcad worksheet. Thanks
Public Sub SizeBoxEvent_Start()
Dim objEX
Dim objMC
Dim MCWS
Dim objEXWB
Dim objEXWS
Dim intLineNo
Dim objRange
End Sub
Sub SizeBoxEvent_Exec(Inputs,Outputs)
Set objMC = CreateObject("MathCad.Application")
Set MCWS = objMC.ActiveWorkSheet
Set objEX = CreateObject("Excel.Application")
Set objEXWB = GetObject("C:\UB_Dims.xls")
Set objEXWS = objEXWB.worksheets("UB")
Dim MyList(71)
For i = 0 to 71
Mylist(i) = CStr(objEXWS.cells(i+3,1))
'MsgBox Mylist(i)
Next
SizeBox.List() = MyList
intLineNo = SizeBox.ListIndex + 3
objRange = "A" & intLineNo & ":U" & intLineNo
Dim varDimProps(21)
Dim varDimName(21)
For i = 1 to 21
varDimProps(i) = objEXWS.cells(intLineNo,i)
varDimName(i) = CStr(objEXWS.cells(1,i))
Next
MCWS.SetValue "Size", ABC
MCWS.SetValue "M", 288
MCWS.SetValue "D", 203
Outputs(0).Value = varDimProps
End Sub
Sub SizeBoxEvent_Stop()
Rem TODO: Add your code here
End Sub
I haven't used Public subs, so I don't know if your declarations will carry over to other subs. Here's something I picked from the PTC forum that works in Excel 2007 with Mathcad 15.0 (I understand that the excel add in is broken for later excel versions).
My guess is that you should define your objects in the functions that use them. Also, I don't think you can use Activeworksheet for the MathCad worksheet.
Private Function RunMCAD(InputFile As String)
Dim MC As Object
Set MC = CreateObject("Mathcad.Application")
MC.Visible = True
Set Wk = MC.Worksheets
Set WS = Wk.Open("C:\RDDA\RDDA 2014-10-16_excel.xmcd")
WS.SetValue "InputFile", InputFile
WS.Recalculate
WS.Save
WS.Close False
MC.Quit
RunMCAD = "Done"
End Function
I would like to add a Control and an associated event at runtime in Excel using VBA but I don't know how to add the events.
I tried the code below and the Button is correctly created in my userform but the associated click event that should display the hello message is not working.
Any advice/correction would be welcome.
Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
UserForm1.Show
The code for adding a button at runtime and then to add events is truly as simple as it is difficult to find out. I can say that because I have spent more time on this perplexity and got irritated more than in anything else I ever programmed.
Create a Userform and put in the following code:
Option Explicit
Dim ButArray() As New Class2
Private Sub UserForm_Initialize()
Dim ctlbut As MSForms.CommandButton
Dim butTop As Long, i As Long
'~~> Decide on the .Top for the 1st TextBox
butTop = 30
For i = 1 To 10
Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)
'~~> Define the TextBox .Top and the .Left property here
ctlbut.Top = butTop: ctlbut.Left = 50
ctlbut.Caption = Cells(i, 7).Value
'~~> Increment the .Top for the next TextBox
butTop = butTop + 20
ReDim Preserve ButArray(1 To i)
Set ButArray(i).butEvents = ctlbut
Next
End Sub
Now you need to add a Class Module to your code for the project. Please remember it's class module, not Standard Module.
The Object butEvents is the button that was clicked.
Put in the following simple code (in my case the class name is Class2).
Public WithEvents butEvents As MSForms.CommandButton
Private Sub butEvents_click()
MsgBox "Hi Shrey from " & butEvents.Caption
End Sub
That's it. Now run it!
Try this:
Sub AddButtonAndShow()
Dim Butn As CommandButton
Dim Line As Long
Dim objForm As Object
Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")
Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With objForm.CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
VBA.UserForms.Add(objForm.Name).Show
End Sub
This permanently modifies UserForm1 (assuming you save your workbook). If you wanted a temporary userform, then add a new userform instead of setting it to UserForm1. You can then delete the form once you're done with it.
Chip Pearson has some great info about coding the VBE.
DaveShaw, thx for this code man!
I have used it for a togglebutton array (put a 'thumbnail-size' picture called trainer.jpg in the same folder as the excel file for a togglebutton with a picture in it). In the 'click' event the invoker is also available (by the object name as a string)
In the form:
Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass
Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)
Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id
Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
("Forms.ToggleButton.1")
With cCont
.Name = idString
.Width = 20
.Height = 20
.Left = 6
.top = top
.picture = LoadPicture(pathToPicture)
End With
ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
CreateTrainerToggleButtonArray(id).ObjectName = idString
End Sub
and a class "ToggleButtonClass"
Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
Public ObjectName As String
Private Sub ToggleButtonEvents_click()
MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
End Sub
Now just simple call from UserForm_Initialize
Private Sub UserForm_Initialize()
Dim index As Integer
For index = 1 To 10
Call CreateTrainerToggleButton(100 + (25 * index), index)
Next index
End Sub
This was my solution to add a commandbutton and code without using classes
It adds a reference to allow access to vbide
Adds the button
Then writes a function to handle the click event in the worksheet
Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
'.Placement = XlPlacement.xlFreeFloating
.Object.Caption = "Export"
.Name = "BtnExport"
.Object.PicturePosition = 1
.Object.Font.Size = 14
End With
Stop
myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")
Call CreateButtonEvent
End Sub
Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End Sub
Private Sub CreateButtonEvent()
On Error GoTo errtrap
Dim oXl As Application: Set oXl = Application
oXl.EnableEvents = False
oXl.DisplayAlerts = False
oXl.ScreenUpdating = False
oXl.VBE.MainWindow.Visible = False
Dim oWs As Worksheet
Dim oVBproj As VBIDE.VBProject
Dim oVBcomp As VBIDE.VBComponent
Dim oVBmod As VBIDE.CodeModule '
Dim lLine As Single
Const QUOTE As String = """"
Set oWs = Sheets("Contingency")
Set oVBproj = ThisWorkbook.VBProject
Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
Set oVBmod = oVBcomp.CodeModule
With oVBmod
lLine = .CreateEventProc("Click", "BtnExport") + 1
.InsertLines lLine, "Call CSVFile"
End With
oXl.EnableEvents = True
oXl.DisplayAlerts = True
Exit Sub
errtrap:
End Sub
An easy way to do it:
1 - Insert a class module and write this code:
Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub
2 - Insert a userform and write this code:
Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub
Now show the form and click the button
I think the code needs to be added to the Userform, not to the button itself.
So something like
With UserForm1.CodeModule
'Insert code here
End With
In place of your With ThisWorkbook