Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all 21884 articles
Browse latest View live
↧

Transfering data from a form to another form

October 10, 2012, 10:12 am
$
0
0
Hi there, I've been trying to find a way of transfering the data the user inputs on a form into another form (that the another user will use for consultation of data).

Here's the situation:

I'm going to just mention the sufficient for my problem, for my program is much larger than what I'm about to refer. I have 3 forms (fBanco, fContas and fCriarConta), the 1st form works as a menu where you can choose several option, which 2 of them are to create a bank account (fCriarConta) and check bank accounts (fContas).
So I have all the code I need to create the bank account, the constructors are well written, as if I leave all the field blank, I get the value "null" returned to all the textbox fields on the back account check (fContas). The problem here is that when I try to send data inputed by the user, meaning that I write on the textbox fields and when I register the bank account, the data that is sent to fContas is the same data as if I didn't write anything on the textbox fields, in other words I still get the value "null" on all textbox fields...

So I tried to check out the problem, I checked the constructors and apparently they're fine, I have 2 constructors for each class (1 doesn't receive any parameters and the other receives the variables that control the data that the user inputs on the textbox fields, thus returning them into the bank account check form (fContas)), then I checked if my If statements were creating any unforseen problems and nothing was found... finally I decided to check the forms' "classes", meaning, on my forms' code I have for the 1st (fBanco) the instance of the form fContas and fCriarConta. Why? Because if I don't instance it, I can't create objects, such as buttons that once clicked will take me to the forms I want (in this case, fContas and fCriarConta). Now even this is necessary, the problem lies here... because on the form that creates bank accounts (fCriarConta) I have a button to register the account, with the following code:

Code:
Private Sub btnRegistar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRegistar.Click
If bla bla bla bla.... Then
Dim CN as New cContaNormal()
Dim fTestForm as fContas = New fContas()
Conta.Add(CN)
RegistoActual = Conta.Count() - 1
Else
Dim CN as New cContaNormal(cbTipoConta.Text, txtNome.Text, txtSobrenome.Text, cbSexo.Text, mDataNasc.Text, txtMorada.Text, mCodPostal.Text, cbEstadoCivil.Text, cbProfissao.Text, 100.0)
Dim fTestForm as fContas = New fContas(cbTipoConta.Text, txtNome.Text, txtSobrenome.Text, cbSexo.Text, mDataNasc.Text, txtMorada.Text, mCodPostal.Text, cbEstadoCivil.Text, cbProfissao.Text)
Conta.Add(CN)
RegistoActual = Conta.Count() - 1
End If

Limpar() 'For the problem I'm having ignore this'

End Sub
See the red colored code lines? That's where I believe my problem is. If you remember, I have already instanced the "class" fContas on my fBanco "class" and if I'm instancing it here again, the data that will always be sent through the 1st constructor and never the 2nd... (at least this is what I can understand)

I know there has to be a way to solve this...
Does anyone know how to solve it?

I'm losing my mind here x.x
↧
Search

Ending and Beginning Balance in Inventory

October 10, 2012, 10:26 am
$
0
0
Ending and Beginning Balance in Inventory

Ex.
Date: Dec 31 , 2012
pcode: 233
product: PENCIL
stock on hand is 7, so Ending Balance is 7
Code:
Stock IN Table
siDate      Qty    Unit    Cost
-------------------------------
Dec20    5      pcs      5.50
Nov15    5      pcs      5.00
Oct20    10    pcs      5.00
Sept5    5      pcs      5.00
How to query data to get results by Jan 1, 2013

The Beginning Balance is 7
Code:
Stock IN Table
siDate      Qty    Unit    Cost
-----------------------------
Dec20    5      pcs      5.50
Nov15    2      pcs      5.00 (note: Original entry in this date is 5pcs)
Code below not yet tested.
Code:
BegBal = 7
chkQty = 0
set rs = cn.execute "Select * from [stockin] where [pcode] = 233 AND [ not sure how to retrieve a row of records where the [siDate] is the latest is read first]"
if NOT rs.EOF then
    Rs.MoveFirst
    ListView1.ListItems.Clear
    Do Until chkQty >= BegBal     
          'Save Temp Data in Listview1
          Set M = ListView1.ListItems.Add(, , Rs!siDate)
                M.SubItems(1) = Rs.Fields!siDate
                M.SubItems(2) = Rs.Fields!pcode
                M.SubItems(3) = Rs.Fields!unitost 

                chkQty = chkQty + rs!Qty

                if chkQty < BegBal then
                    M.SubItems(4) = chkQty
                ElseIf chkQty > BegBal then
                    chkQty =  BegBal - rs!Qty
                    M.SubItems(4) = chkQty
                    Exit Do
                ElseIf chkQty = BegBal then
                    chkQty = rs!Qty
                    M.SubItems(4) = chkQty
                    Exit Do 
                End If   
                Rs.MoveNext
        loop
End If
Then Delete all Stockin Data
Code:
Set Rs = cn.Execute("select * from stockin where pcode=233 ")
Insert Temp data from Listview1 to database
Code:
Dim stringSQLT As String
Dim i

    Call open_conn
    For i = 1 To ListView1.ListItems.Count
        stringSQLT = "INSERT  INTO stockin (siDate,pcode,unitcost,Qty) " _
            & "VALUES("
        With ListView1.ListItems.Item(i)
            stringSQLT = stringSQLT &  "#" & .SubItems(1) & "#","          'siDate
            stringSQLT = stringSQLT & Val(.SubItems(2)) & ","                'pcode
            stringSQLT = stringSQLT & cdec(.SubItems(3)) & ","              'unitcost
            stringSQLT = stringSQLT & Val(.SubItems(4))                      'Qty
            stringSQLT = stringSQLT & ")"
            cn.Execute stringSQLT
        End With
    Next i
    Call close_conn
↧
↧

Downloading trouble, maybe olelib not registered

October 10, 2012, 1:05 pm
$
0
0
It's been a while since I have did any programming, over a year now.

I'm trying to use a program I wrote a couple of years ago that was working fine when I last used it. The only thing that has changed since I last used it is I had to get a new computer, upgrading from Windows XP to Windows 7 in the process.

The program I'm using uses olelib/olelib2 type libraries. I'm not sure if they are registerd or not.

The problem I'm having is the program won't let me download any of the files that I'm trying to download. It removes all of them from the to be downloaded list and puts them on the already downloaded list but the files haven't been downloaded. As I watch the screen the progress bar isn't showing the files are being downloaded either. When I go into the program to try to find out if it is coming up with any error code it is coming up with File Not Found, as in it isn't finding the file on the internet server so it can download it. The file is there as I can watch the video file or download it when not using the program.

I'm not really sure what the problem is but I'm tending to think I might have a bit of unregistered .tlb trouble.

I'm open for suggestion and also when it comes to registering a tlb on Windows 7 how do I go about doing it.

I have checked and References is pointing to the correct location C:\Windows\SysWOW64\olelib.tlb
↧

VB6 export crystal PDF and attach to email using MAPI

October 10, 2012, 3:46 pm
$
0
0
I want to
1. Export a crystal report to PDF
2. Attach this file to a new email.

I can do the first part but I'm getting an error on the second part Error 32012 Failure on Opening Attachment. My code is:
Code:
    Dim CApp As New CRAXDRT.Application
    Dim CReport As CRAXDRT.Report
    Dim CRExportOptions As Object
 
 
    expFile = "C:\Report\rep1.rpt"
    Set CReport = CApp.OpenReport(expFile)
    FileLoca = Left(expFile, Len(expFile) - 3) & "pdf"
   
    CReport.EnableParameterPrompting = False
    CReport.DiscardSavedData
    CReport.ReadRecords
   
    Set CRExportOptions = CReport.ExportOptions
    CRExportOptions.FormatType = crEFTPortableDocFormat      '
    CRExportOptions.DestinationType = crEDTDiskFile
    CRExportOptions.DiskFileName = FileLoca
    CReport.DisplayProgressDialog = False
    CReport.Export False
   
    Set CRExportOptions = Nothing
       
    MAPISession1.SignOn
    With Me.MAPIMessages1
        .SessionID = MAPISession1.SessionID
        .MsgIndex = -1
        .Compose           
        .AddressEditFieldCount = 1
        .MsgNoteText = strmessage
       
        .AttachmentPosition = 0
        .AttachmentName = "" & FileLoca & ""
        .AttachmentPathName = "" & FileLoca & ""
        .AttachmentType = mapEOLE
        .Send True       
    End With
   
    MAPISession1.SignOff
I'm using VB6, Crystal XI and Vista.
↧

System Tray Icon Goes Black After Standby Mode

October 10, 2012, 6:24 pm
$
0
0
Hello, I have an application that sits in the windows system tray. This application flashes at certain intervals. The way I do this is by using a timer, and change the icon every second for a shor interval. This gives the effect of a flashing icon. All of this works good without issues. Here is where the problem starts. I noticed that if the computer goes into standby mode or hibernation and then starts again, if an icon hadn't previously been shown (flashing hadn't occured yet) the icon that hadn't been shown before standby-mode shows as black. The shape of the icon is correct but is black. The current icon that the application was displaying in the system tray before the stand-by mode shows correct color and all. Anybody have any idea what the issue could be?

Keep in mind that the icons to be displayed are stored in image objects that are on the main form of the application. I tried putting the icons into an imagelist and still had the same issue.

This is how I flash the icon in the system tray using an ImageList object. The same occurs using an Image object.

Code:
nid.hIcon = Me.imgIcon.ListImages(0).Picture
Shell_NotifyIcon NIM_MODIFY, nid

nid.hIcon = Me.imgIcon.ListImages(1).Picture
Shell_NotifyIcon NIM_MODIFY, nid
Thanks for any insight in what may be causing this.
↧
↧

help to export from vb6 to openoffice spreadsheet

October 11, 2012, 3:30 am
$
0
0
Dear friends

I have any application which is using sql server at backend and vb6 as front end. I export data from the record set to excel sheet easily in this application.

now i got a requirement to export data from record set to open office spreadsheet. i m new to open office, i have installed it but dont know what reference i should made and secondly whats the coding for exporting record set to open office spreadsheet. please if some one can guide me . i dont need to save the spread sheet , i just need to open a temporary spread sheet which user can view. its at user's discreation if he wants to save it or not.


any guidance will be welcomed

thanks in advance

shivpreet2k1
↧

Vb6 how to find a record based on multiple id

October 11, 2012, 10:33 am
$
0
0
I have a table in my database based on a multiple ID
FirstID SecondID they are both primary keys I understand the vb find a record with one primary key
I haven't got a clue how to do this with 2 primary keys
I also want to check if the combination of those keys exists
FirstID is an existing key from another table SecondID is the new key
so a get keys like 1.1 1.2 1.3 an so on
↧

[RESOLVED] Hi, Need some help adding code to my web browser

October 11, 2012, 10:50 am
$
0
0
Hi, when ever I open up an address like msn.com or yahoo.com, google.com I get a message that says there was a script error here is my code, oh and I want to make it that my images of refresh and exit and search image they dong get big like the browser its self and the text box to type a address in, so is the a way to make it get grow with the browser and i want the images to get centered with the browser if that can be done.. thanks:wave:

Code:





Private Sub Form_Load()
'Form_Load is in every VB program

Text1.Text = "http:\\www."

WebBrowser.Navigate "http:\\www."

End Sub

Private Sub Form_Resize()

On Error Resume Next 'the most common error handler in vb

If WebBrowser.Left = 0 Then 'if the webBrowser's position is 0 then

End If
'its kind of confusing here, try playing with the number values
WebBrowser.Width = Me.Width - 200 - WebBrowser.Left 'me.width is refering to the webBrowser
WebBrowser.Height = Me.Height - WebBrowser.Top - 1000 'this subtracts one thousand fromt he form's window top.

End Sub



Private Sub Image1_Click()
If Not Left(Text1.Text, 11) = "http://www." Then
End If
WebBrowser.Navigate Text1.Text


End Sub

Private Sub Image3_Click()
Timer1.Enabled = True 'this calls Timer1 to begin.

End Sub

Private Sub Image4_Click()
End

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
'this command is more in depth and takes a while to grasp
'Its the Keyascii that is vital

If KeyAscii = 10 Then
'if the user strikes the Enter key

If Not Left(Text1.Text, 11) = "http://www." Then
'the if not line is saying to Text1, that if http://www.
'is not included then include it into webBrowser.

Text1.Text = "http://www." + Text1.Text + ""
'so http://www. plus whatever the user types and insted of
'hitting enter they hit our Text1_KeyPress, the Enter key, then
'it carries the text to the webBrowser.

WebBrowser.Navigate Text1.Text 'this sets up webBrowser to navigate to whatever Text1 is.
End If
End If

If KeyAscii = 13 Then 'if user hits the enter key

WebBrowser.Navigate Text1.Text 'navigates the webBrowser to whatever Text1 is.

End If

End Sub

Private Sub Timer1_Timer()

WebBrowser.Refresh 'this means to refresh the website  .refresh is usful.

Timer1.Enabled = False 'sets the timer1 to false to turn it off
End Sub

'this is hard to grasp because the title is changing to something we don't know.
'The "ByVal" makes "Text" and "As String" stores the data(the data is the websites title), in "Text"
Private Sub WebBrowser_TitleChange(ByVal Text As String) 'ByVal makes "Text" variable.
'and "As String" is how it is stored.

Me.Caption = "The web address:    -    " + Text ' this "Text" does not acctually mean writing text.
'Me.Caption is refering to the webBrowser's titlebar text
'the + "Text" means plus the webBrowser's text. "ex: The web address: - ass.com"

End Sub
↧
Search

Many buttons do the same thing

October 11, 2012, 10:55 am
$
0
0
Every button posts a letter a label.
Btn_A.Text = "A" and Btn_B.Text = "B" etc..
Is it possible to make every button post its own btn.text into a label, without having to write so many lines of code?

The code as it is now:

Public Sub Alleknapper(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Btn_A.Click, Btn_B.Click, Btn_C.Click, etc.......

Select Case True
Case sender Is Btn_A
Label1.Text += Btn_A.Text
Case sender Is Btn_B
Label1.Text += Btn_B.Text
Case sender Is Btn_C
Label1.Text += Btn_C.Text

etc.......

End Select
↧
↧

[RESOLVED] How do i change the color of a Toolbar1 to white

October 11, 2012, 12:24 pm
$
0
0
He, Everyone is there a way to change the color of a Toolbar1 to the color white. I have never used a Toolbar1 before so that's why im asking. thanks:wave:
↧

Nested If returning no output

October 11, 2012, 1:34 pm
$
0
0
Hi

I have been working on the code below for a long time, but continue to get no output.
Is there an issue with the nested if... then... else coding?

Values in cells(x,18) and cells(x,19) = 0
Value in cells(x,15) = 1
Value in cells(2,3) = 5
Values in cells(2,10) = 0

I would have thought the code should have worked (one in bold below). However, it returns no output whatsoever. Can anyone assist in help solve this?

Many thanks
/|/|


Sub Row()
x=2
y=3

Sheets("TPL").Select
'Row

'when prev S? or S!>0
If Cells(x, 18) > 0 Or Cells(x, 19) > 0 Then
If Cells(y, 6) = "L" Then
Cells(y, 7) = Cells(y, 4) + 1
End If
ElseIf Cells(x, 18) > 0 Or Cells(x, 19) > 0 Then
If Cells(y, 6) = "S" Then
Cells(y, 7) = Cells(y, 5) + 1
End If
'when prev S? and S! = 0; prev A?>0
ElseIf Cells(x, 18) = 0 And Cells(x, 19) = 0 Then
If Cells(x, 15) > 0 Then
If Cells(x, 10) = Cells(2, 3) Then
Cells(y, 7) = Cells(x, 7) + 1 'when prev U = max units, add 1 to the prev row
End If
End If
ElseIf Cells(x, 18) = 0 And Cells(x, 19) = 0 Then
If Cells(x, 15) > 0 Then
If Cells(x, 10) < Cells(2, 3) Then
Cells(y, 7) = Cells(x, 7) 'when prev U not equal to max units, continue with the prev row
End If
End If
'when prev S? and S! = 0; prev A?=0
ElseIf Cells(x, 18) = 0 And Cells(x, 19) = 0 Then
If Cells(x, 15) = 0 Then
If Cells(x, 10) >= Application.WorksheetFunction.Max(Range(Cells(x, 10).Offset(Cells(x, 11), 0), Cells(x, 10))) Then
Cells(y, 7) = Cells(x, 7) + 1 'when prev A?=0 and prev U is max
End If
End If
ElseIf Cells(x, 18) = 0 And Cells(x, 19) = 0 Then
If Cells(x, 15) = 0 Then
If Cells(x, 10) < Application.WorksheetFunction.Max(Range(Cells(x, 10).Offset(Cells(x, 11), 0), Cells(x, 10))) Then
Cells(y, 7) = Cells(x, 7) 'when prev A?=0 and prev U is max
End If
End If
Else: Cells(y, 7) = "Error"
End If
End Sub
↧

Envelope printing

October 11, 2012, 2:09 pm
$
0
0
Is there any pre done envelope printing functions/add-ons, etc. to handle envelope printing (not using Crystal Reports)? Or do I have to manually handle the placing of text differently if the the users printer centers envelope feeding vs left or right feeding AND turning the printing vertical as opposed to horizontal? I like the Office icons which show each of the 6 options, plus flipping, etc. I can't really seem to find anything in the help files or searching here. Any help or direction would be appreciated.
↧

[RESOLVED] Array Question

October 11, 2012, 2:20 pm
$
0
0
How do I know if an array is empty?
↧
↧

Code Makes No Sense to Me

October 11, 2012, 2:36 pm
$
0
0
I'm no vb expert by any stretch of the imagination.

While looking at a piece of VB6 code to convert to C#, I found myself dumbfounded as to why this code was written the way it was.

Maybe I'm missing something.

This code is part of a code module that contains functions for figuring out MOON PHASES.

What this particular function appears to do is simply return the date "12/30/1899" along with the TIME found in the string "sTime" passed to it.


Code:
Function pfunDayZero(sTime As String) As String

Dim dDate As String, iPosition As Integer, dTemp As String
Dim sReplace As String, iStart As Integer

    'Initialize
    iStart = 1
    iPosition = 0
    dDate = CVDate(1 + TimeValue(sTime))
    sReplace = Day(DateSerial(1899, 12, 30))
   
    'Search routine
    Do
        dTemp = dDate
        iStart = 1 + iPosition
        iPosition = InStr(iStart, dTemp, Day(DateSerial(1899, 12, 31)))
        Mid(dTemp, iPosition, Len(sReplace)) = sReplace
        If Not IsDate(dTemp) Then dTemp = dDate
       
    Loop Until DateValue(dTemp) = 0

    pfunDayZero = dTemp


End Function
It seems that no matter what date or time is passed to the above function, I get back 12/30/1899 plus the original TIME passed into the function as a Date/Time string.

For example:

sTime = "05/06/2010 05:00:00"

You get back "12/30/1899 05:00:00".


So why does this code include all kinds of conversions and string parsing, etc.?

It would seem to me that all I'd have to do to rewrite this in my C# (or any other language) is to simply get the TIME value from any passed date and to append that TIME to "12/30/1899" before returning it.

Does anyone see an INTENT for the above code that I am missing?

All the functions in this module seem to work fine in getting me the correct moon phases, so I have to assume they are working fine.


TIA

Webbiz
↧

VB6 complied EXE all of sudden became very big

October 11, 2012, 3:02 pm
$
0
0
Hi All
I have an old application in VB6 running for years. From time to time I made few changes and recompile.
Today I made a change referencing actrpt2.dll to an older version and all of sudden the exe size changed from 2.5 MB to 60. If I change the reference back to a different version of actrpt2.dll it goes back to 2.5MB
Any idea what is the issue?
Thanks
maylo
↧
Search

getting Current week no from system date

October 11, 2012, 3:55 pm
$
0
0
Can anyone tell me ? .How should i get current weekno on the basis of sytem date .let me know please .any help would be highly appreciated .
Code:


Option Explicit

Private Sub Command1_Click()
GetCurentWeekNo (Now)
End Sub

Public Sub GetCurentWeekNo(CurDate As Date)
Dim myDate As Date
myDate = Format(CurDate, "dd/mm/yyyy")
Dim mYear As Integer
Dim mMonth As Integer
Dim mDay As Integer
mYear = Format(myDate, "YYYY")
mMonth = Format(myDate, "mm")
mDay = Format(myDate, "dd")
Dim dteStartOfYear As Date
Dim dteWorkingDate As Date
Dim intWeeks As Integer
    dteStartOfYear = DateSerial(2012, 7, 1)
    dteWorkingDate = DateSerial(mYear, mDay, mMonth)
    intWeeks = DateDiff("ww", dteStartOfYear, dteWorkingDate)
   
    MsgBox intWeeks
End Sub
↧

Hi need some hep on how to make my visual basic 6.0 programs work on all

October 11, 2012, 3:56 pm
$
0
0
Hi need some help on how to make my visual basic 6.0 programs work on all windows operating system like windows xp,Vista,windows 7, and 8 when it comes out. thanks
↧
↧

Runtime 48 Error loading dll error on CopyTableDef

October 11, 2012, 6:11 pm
$
0
0
I am getting a runtime 48 Error loading dll message and failure when this code runs on a windows 7 pro 64 bit machine. It runs on similar machines in other offices. What can I look for to debug this? As you can see I am writing out a log file as I progress through the code. I belive this line For Each tbl In Glob.dbAppDB.TableDefs is where it is throwing the error. Any help is appreciated.
Code:
Private Sub CopyTable(from_name As String, to_name As String)

Dim dbSource As Database
Dim CmdStatement As String
Dim nCtr As Integer
Dim tbl As New TableDef
Dim fld As Field
Dim ind As Index
Dim ds1 As Recordset
Dim ds2 As Recordset
'Dim ds1 As Dynaset
'Dim ds2 As Dynaset
Dim RecSetTable As Recordset
Dim ErrLoc As String
Dim blnTableExists As Boolean

On Error GoTo ErrorRoutine
ErrorCode = 0
''check to see if the table exists, if it does then delete records and move back to VisualScrap
ErrLoc = "CHECKEXIST"
Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "Check if Exist")
blnTableExists = False
For Each tbl In Glob.dbAppDB.TableDefs
    If UCase$(tbl.Name) = UCase(to_name) Then
        blnTableExists = True
        Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "Check if Exist=True")
        Exit For
    End If
Next

'CmdStatement = "SELECT * FROM " & to_name
'Set RecSetTable = Glob.dbAppDB.OpenRecordset(CmdStatement, dbOpenDynaset)
'If ErrorCode = 0 Then
If blnTableExists = True Then
'    RecSetTable.MoveLast
'    If RecSetTable.RecordCount > 0 Then
        ErrLoc = "DELETE PRIOR RECORDS"
        Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "Delete Prior Records")
        If Glob.DataType = 1 Then
            CmdStatement = "DELETE * FROM " & to_name
        Else
            CmdStatement = "DELETE FROM " & to_name
        End If
        Glob.dbAppDB.Execute (CmdStatement)
'    End If
Else
    ErrLoc = "CREATE TABLE"
    Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "CreateTable with TableDefs-" & to_name)
    tbl.Name = to_name
    ErrLoc = "CREATE TABLE-1"
    For nCtr = 0 To Glob.dbAppDB.TableDefs(from_name).Fields.Count - 1
        Set fld = New Field
        ErrLoc = "CREATE TABLE-2    "
        fld.Name = Glob.dbAppDB.TableDefs(from_name).Fields(nCtr).Name
        fld.Type = Glob.dbAppDB.TableDefs(from_name).Fields(nCtr).Type
        fld.Size = Glob.dbAppDB.TableDefs(from_name).Fields(nCtr).Size
        If Glob.dbAppDB.TableDefs(from_name).Fields(nCtr).AllowZeroLength = True Then
            fld.AllowZeroLength = True
        End If
       
        fld.Attributes = Glob.dbAppDB.TableDefs(from_name).Fields(nCtr).Attributes
        ErrLoc = "CREATE TABLE-3"
        tbl.Fields.Append fld
    Next
    ErrLoc = "CREATE TABLE-4"
    For nCtr = 0 To Glob.dbAppDB.TableDefs(from_name).Indexes.Count - 1
        Set ind = New Index
        ErrLoc = "CREATE TABLE-5"
        ind.Name = Glob.dbAppDB.TableDefs(from_name).Indexes(nCtr).Name
        ind.Fields = Glob.dbAppDB.TableDefs(from_name).Indexes(nCtr).Fields
        ind.Unique = Glob.dbAppDB.TableDefs(from_name).Indexes(nCtr).Unique
        ind.Primary = Glob.dbAppDB.TableDefs(from_name).Indexes(nCtr).Primary
        tbl.Indexes.Append ind
    Next
    ErrLoc = "CREATE TABLE-6"
    Glob.dbAppDB.TableDefs.Append tbl
End If
Set RecSetTable = Nothing
ErrLoc = "CREATE TABLE-7"
CmdStatement = "INSERT INTO " + to_name + " SELECT * FROM [" + from_name + "];"
Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "Insert" & CmdStatement)
Glob.dbAppDB.Execute (CmdStatement)
ErrLoc = "CREATE TABLE-8"
strTableCreated = "SUCCESS"

Exit Sub
ErrorRoutine:
'debug.print err.Number
ErrorCode = err.Number
ErrorDesc = err.Description
Call WriteErrLog("protocol_CreateTables", "CopyTable", "CreateTbl", "Error=" & ErrorCode & ErrorDesc)
If ErrorCode = 3078 And ErrLoc = "CHECKEXIST" Then
    Resume Next
End If

strTableCreated = "ERROR:" + ErrorCode + " " + ErrorDesc

Call WriteErrLog("protocolCreateTables", "CopyTable", "CopyTableErr", ErrorCode & " " & ErrorDesc)

End Sub
↧

object Variable or with block no set

October 11, 2012, 6:46 pm
$
0
0
help. i have 5 problem ..help me
Attachment 92287
this code :
Private Sub Cmd_SIMPAN_Click()
'txt_cus_id.Text = generate_code

mKar_ID = txt_cus_id.Text
mKar_Name = txt_cus_name.Text
mKar_Tmpt = txt_tmp.Text
mKar_TglLahir = TglLahir_dtp.Value
mKar_JenisKelamin = Cmb_kelamin.ListIndex
mKar_Agama = Cmb_Agama.Text
mKar_Alamat = txt_alamat.Text
mKar_City = txt_cus_city.Text
mKar_Jabatan = txt_jabatan.Text
mKar_Phone = txt_Cus_Phone.Text

mKar_NamaFile = Text1.Text
'MsgBox Cmd_SIMPAN

If Cmd_SIMPAN.Caption = "SAVE ADD" Then
txt_cus_id.Text = generate_code
If Len(txt_cus_id.Text) > 12 Then
mTemp = MsgBox("Karyawan ID tidak boleh > 12 karakter", vbOKOnly)
txt_cus_id.SetFocus
Exit Sub
End If
mSQL = "insert Tabel_Karyawan (Kar_ID, Kar_Name, Kar_Tmpt, Kar_TglLahir, Kar_JenisKelamin, Kar_Agama, Kar_Alamat, Kar_City, Kar_Jabatan, Kar_Phone ) " & _
" values ('" & txt_cus_id.Text & "','" & mKar_Name & _
"','" & mKar_Tmpt & "','" & mKar_TglLahir & "','" & mKar_JenisKelamin & "','" & mKar_Agama & "','" & mKar_Alamat & "','" & mKar_City & "','" & mKar_Jabatan & "','" & mKar_Phone & "')"
Else
mSQL = "Update Tabel_Karyawan set Kar_Name ='" & _
mKar_Name & "', Kar_Tmpt='" & mKar_Tmpt & "', Kar_TglLahir='" & mKar_TglLahir & "', Kar_JenisKelamin='" & mKar_JenisKelamin & "', Kar_Alamat='" & mKar_Alamat & "', Kar_City ='" & mKar_City & _
"', Kar_Jabatan='" & mKar_Jabatan & "', Kar_Phone= '" & mKar_Phone & "' where Kar_ID = '" & txt_cus_id.Text & "'"
End If
MsgBox mSQL
'Update datagrid setelah update database berhasil
Set objCommand = New ADODB.Command
objCommand.ActiveConnection = objConnection
objCommand.CommandText = mSQL
objCommand.CommandType = adCmdText
' On Error Resume Next
objCommand.Execute
If Err.Number <> 0 Then
MsgBox "gagal menambah/meng-update record" & vbCrLf & Err.Description
Else
If Cmd_SIMPAN.Caption = "SAVE ADD" Then
objRecordset.AddNew
End If
'harus gunakan nilai dari tampungan sementara, alasannya?! cari tau sendirilah
'karena telah terjadi insert atau addnew :)
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 0) = mKar_ID
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 1) = mKar_Name
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 2) = mKar_Tmpt
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 3) = mKar_TglLahir
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 4) = mKar_Alamat
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 5) = mKar_City
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 6) = mKar_Jabatan
' grid_Data_Karyawan.grid_Data_Karyawan.TextMatrix(grid_Data_Karyawan.Row, 7) = mKar_Phone
End If
On Error GoTo 0

If Cmd_SIMPAN.Caption = "SAVE ADD" Then
' ListKaryawan_frm.Show vbModal
blank_data
txt_cus_id.SetFocus
Else
blank_data
disable_entry
enabled_command
End If
End Sub

Private Sub Cmd_EXIT_Click()
If Cmd_EXIT.Caption = "EXIT" Then
Unload Me
Else
blank_data
disable_entry
enabled_command
End If

End Sub


Private Sub Command1_Click()
Dim totalhari As Integer
Dim umur As Integer
Dim hari As Integer

totalhari = DateDiff("d", TglLahir_dtp.Value, Date)
umur = totalhari / 365
hari = totalhari - (umur * 365)
MsgBox "Umur Anda " & umur & " tahun " & hari & " hari"
End Sub

Private Sub Form_Activate()
Dim Atas As Long
Dim Kiri As Long
Atas = (Screen.Height - Me.Height) / 2
Kiri = (Screen.Width - Me.Width) / 2
Me.Move Kiri, Atas
End Sub

Private Sub Form_Load()
Set objConnection = New ADODB.Connection
With objConnection
.ConnectionString = Penjualan_Menu.mRoot_StrConn
.Open
If Not .State = adStateOpen Then
MsgBox "tidak dapat membuat hubungan ke database"
Unload Me
End If
End With
load_objrecordset
blank_data
data_length
disable_entry
enabled_command

' Cmb_kelamin.AddItem "Pria"
' Cmb_kelamin.AddItem "Wanita"
' 'Jenis Kelamin
' If UCase(Trim(strJK)) = "WANITA" Then Cmb_kelamin.ListIndex = 1 Else Cmb_kelamin.ListIndex = 0
' Set objRecordset = New ADODB.Recordset
'mSQL = "select id_jeniskelamin, jeniskelamin from m_jeniskelamin order by jeniskelamin "
'With objRecordset
' .ActiveConnection = objConnection
' .CursorLocation = adUseClient
' .CursorType = adOpenStatic
' .LockType = adLockBatchOptimistic
' .Source = mSQL
' .Open
'End With
'Memilih Jenis Kelamin

'Jenis Kelamin
If UCase(Trim(strJK)) = "WANITA" Then Cmb_kelamin.ListIndex = 1 Else Cmb_kelamin.ListIndex = 0


Cmb_Agama.AddItem "Islam"
Cmb_Agama.AddItem "Kristen Protestan"
Cmb_Agama.AddItem "Katholik"
Cmb_Agama.AddItem "Hindu"
Cmb_Agama.AddItem "Budha"
Cmb_Agama.AddItem "Konghuchu"
Cmb_Agama.AddItem "Atheisme"
Cmb_Agama.AddItem "Lain-Lain"
'Agama
If UCase(Trim(strAgm)) = "Islam" Then Cmb_Agama.ListIndex = 1 Else Cmb_Agama.ListIndex = 0
End Sub:cry::sick:
Attachment 92289
Attached Images
   
↧

How to divide numbers

October 12, 2012, 7:17 am
$
0
0
Hi guys does anybody know how i can make it divide the numbers put in text1 and text 2?

for example

text 1 = 100
text 2 = 4

when command1 is pressed it then divides text1 by text2


any ideas?

thanks
Jamie
↧
Viewing all 21884 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>