A1VBCode Forums / Classic Visual Basic (VB 6 or earlier) / VBA(Excel, Word, etc...)

how to embed ms office into vb 6

belat — Tue, 16 Feb 2010 06:35:30 GMT

hi sir...i just want to ask if how i could

embed microsoft office application in vb 6

that the content will be saved in the database and can be viewed

from the database....

mysql database..

thanks..

Problems running VBA code within Excel

sclward — Mon, 15 Feb 2010 11:17:24 GMT

Have created the following code to export Excel worksheet data to Access database. Had early issues with registering type to allow system to recognize the Dim statement. Setup object library to include Microsoft DAO 3.6 Object Library, but now when trying to compile macro I get a runtime error '429' that an ActiveX component can't create object on the Set db statement of the code. What am I missing?

Sub DAOFromExcelToAccess()
'exports data from the active worksheet to a table in an Access database
'this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\Documents and Settings\sward\My Documents\Austell Equipment\GM-130\Productivity Reports\Machine_Logging.mdb")
'open the database
Set rs = db.OpenRecordset("GM130", dbOpenTable)
'get all records in a table
r = 1 'the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
'repeat until first empty cell in column A
With rs
.AddNew 'create a new record
'add values to each field in the record
.Fields("Customer") = Range("A" & r).Value
.Fields("Metallizer") = Range("B" & r).Value
.Fields("Met_Date") = Range("C" & r).Value
.Fields("Vac_Roll_Number") = Range("D" & r).Value
.Fields("Met_Quality") = Range("E" & r).Value
.Fields("Met_Performance") = Range("F" & r).Value
.Fields("Met_Downtime") = Range("G" & r).Value
.Fields("Slitter") = Range("H" & r).Value
.Fields("Slit_Date") = Range("I" & r).Value
.Fields("Slit_Quality") = Range("J" & r).Value
.Fields("Slit_Performance") = Range("K" & r).Value
.Fields("Slit_Downtime") = Range("L" & r).Value
'add more fields if necessary...
.Update 'store the new record
End With
r = r + 1 'next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

Export Excel worksheet to Access using VBA

sclward — Sun, 31 Jan 2010 12:08:31 GMT

I'm wanting to export an Excel worksheet to an existing Access table. I want to do this from within Excel using VBA and a user macro. I want to be able to append the existing records within the Access table. What's the best way to do this? Thanks.

Use sub

samuvk — Thu, 28 Jan 2010 15:13:10 GMT

I'm using Visual Basic in Excel 2003.

I have a Sub definied as follow:

Public Sub Conect(ByVal hServer As Long, ByVal hpool As Long, ByVal vServerName As Long, ByVal vUserName As Long, ByVal vPassword As Long, hUser As Long)

BODY

End Sub

The thing is when I try to call the Sub I'm doing as follow:

Sub Conect(hServer, hpool, vServerName, vUserName , vPassword , hUser

When I call the Sub I get the next error message:

Compile error:

Expected:=

Could anyone help me to understand why is this happening and how can I fix it?

The thing is that when I use only one variable I don't have any problem

Need code for expanding Word table rows with copied default formfields

SeefDawg — Tue, 19 Jan 2010 15:34:52 GMT

I'm working on a Word template (form) that contains tables having a mix of formfields such as textinput, dropdowns, and checkboxes. I would like to provide a single default data row for each table, but if the user enters valid data in the first cell of the last row, the table expands with a new default row below the active cell the user just filled in. The following code is latest draft for a table where default textinput for cell(1) is "nn", but requires at least two data rows and is not smart enough to know if another default row is available below the active (selected) cell:

Sub AddRow()
Dim thisDoc As Document
Set thisDoc = ActiveDocument
Dim oTable As Table
Dim oCell As Cell
Dim oPrevRow As Row, oNewRow As Row
Dim tmp
'Unprotect Document
If thisDoc.ProtectionType <> wdNoProtection Then
thisDoc.Unprotect
End If

tmp = Selection.Text
If tmp <> "nn" Then
If tmp <> "n" Then
'Selection.FormFields(1).TextInput.Clear
' Copy last row
Set oTable = thisDoc.Tables(10)
Set oPrevRow = oTable.Rows(oTable.Rows.Count)
oPrevRow.Range.Copy
Set oNewRow = oTable.Rows(oTable.Rows.Count)
' Copy last row to new row
oNewRow.Range.Paste

End If
End If
'Protect Document
If thisDoc.ProtectionType = wdNoProtection Then
thisDoc.Protect wdAllowOnlyFormFields, NoReset:=True
End If
End Sub

I also would like to ensure that the formfields in the new row are reset to their default values without resetting the entire form.

Loss VBA Password

yuro84 — Sat, 12 Dec 2009 03:01:26 GMT

Anybody can help me how to crack my excel VBA password?

A template for making bound documents

Pepper — Sun, 27 Dec 2009 04:23:28 GMT

I would like to have a template for preparation of bound documents.

For example, I have prepared a document of 4 pages. On an extra (5^th, auxiliary) page there is an inscription “Bound, numbered and sealed are 4 (Four) sheet(s)”.

Then I cut this inscription with scissors, staple the document, sew it with a thread, and then glue the sticker.

Testing for blank and/or empty rows or columns

devophil — Sat, 26 Dec 2009 19:08:40 GMT

I wish to loop through each row of a set area of a worksheet and delete only those rows which have nothing stored, regardless of whether they have never been used, or, if they once had contents in a cell/s that have since been cleared. If any cell in the row has had its formatting altered or anything, I still wish it to be considered empty; as long as there is no formula or entry in a cell, I want it detected to be deleted.

1. My text has the line

If IsEmpty(Range("A1")) then ....

which will test only if a particular cell is empty.

If I try

If IsEmpty(rows(1)) then

there is no compile error, but, if row 1 (1) has nothing in any cell, it still won't match if I have nothing in row 1 of the worksheet.

2. What is the difference between somthing being empty or something being null? I have tried other codes with null to try to detect empty lines, but they've caused run errors or again logical ones.

Many thanks to anyone who can assist :-)

VBA MSG BOX

yuro84 — Sat, 12 Dec 2009 04:17:46 GMT

Hi,
Can someone help me? I want to develop my spreadsheet as below;
Let say if:

A1>12.5 the off spec msg box will appear
B1>12, the off spec msg box appear

In the msg box:
A= offspec. Reason = To be filled by user. Action taken: To be filled by user
B=offspec. Reason=To be filled in by user. Action taken: To be filled by user
Ok button.

After click ok button, another form appear in excel format and the input at the “to be filled by user” will be appear in the form

Controls- Populating a textbox with Access values

Sunzah — Thu, 03 Dec 2009 07:57:27 GMT

I'm working on Access 2003 and i was creating a report. Now that i'm done creating my report how do i go about binding textboxes [Unbound Fields] to dbase or what's the code that populates the the textbox in the report which should pick up a certain column in a certain table in a database

Excel Update

kippi — Fri, 13 Nov 2009 11:03:28 GMT

Hey Guys,

I have been left an excel spreadsheet from the last IT person here. He left some documents on how to setup the machine for this but left a whole load of information out, for example that I need to register WINSOCK.

I have got one PC working with the spreadsheet but the other machine errors when when I try to do an update with "#ErrorDB Error: Update AskDiscountMargin not updated." If I run excel with as Admin it works fine.

What would the best way of debuging this be?

The sheet is updating a MySQL database, I have all the permissions on WINSOCK etc.

Thanks for your help.

Chris

DATE COLUMN

gencom99 — Thu, 24 Sep 2009 15:34:35 GMT

I am connecting to Oracle through MS QUERY. The result is put into excel.

Set Query = QuerySheet.QueryTables("MONEY")
Query.Sql = "SELECT NUMB_TBLE.NUMB_NAME, TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'MONTH'), SUM(NUMB_TBLE.NUMB_PAY) " _
& "FROM JES.NUMB TBLE NUMB TBLE,
JES.NUMB_DATES_TBLE NUMB_DATES_TBLE" _
& "WHERE NUMB_TBLE.NUMB_ID = NUMB_DATES_TBLE.NUMB_ID AND NUMB_TBLE.NUMB_CODE IN (" & NumList & ") " _
& "Group by numb_tble.numb_name, TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'MONTH')
ORDER BY TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'MONTH')

This doesn't accomplish what I want

In my query, I want to display the month in words
I want to order the month by number

For example the result would be

Jones January 10.00
Doe April 20.00

How do I do this?

Column alias

gencom99 — Wed, 23 Sep 2009 13:26:02 GMT

I would like to put column aliases on some of the fields in the SELECT statement.

Private Sub CommandButton1_Click()
Dim NumList As String
Dim SourceBook As Workbook
Dim ListSheet As Worksheet
Dim QuerySheet As Worksheet
Dim Query As QueryTable
Dim Numb As String

Set SourceBook = Application.ActiveWorkbook
Set ListSheet = SourceBook.Worksheets("Main")
Set QuerySheet = SourceBook.Worksheets("MONEY")
Numb = Range("H6")

If ListSheet.Cells(6, 8).Value = "" Then Exit Sub
NumList = "'" & ListSheet.Cells(6, 8).Value & "'"

Set Query = QuerySheet.QueryTables("MNY")
Query.Sql = "SELECT NUMB_TBLE.NUMB_NAME, extract(month from NUMB_DATES_TBLE.DAY_MTH_YR) " _
& "FROM JES.NUMB TBLE NUMB TBLE,
JES.NUMB_DATES_TBLE NUMB_DATES_TBLE" _
& "WHERE NUMB_TBLE.NUMB_ID = NUMB_DATES_TBLE.NUMB_ID AND NUMB_TBLE.NUMB_CODE IN (" & NumList & ") " _
& "Group by numb_tble.numb_name,
extract(month from NUMB_DATES_TBLE.DAY_MTH_YR)

Query.Refresh (False)

End Sub

I want to alias the column NUMB_TBLE.NUMB_NAME, I want it to say LAST_NAME

I have tried NUMB_TBLE.NUMB_NAME AS LAST_NAME. It works but it changes the order of the columns. I do not want the order of the columns to change.

When the query runs, in Excel, the column headings are DAY_MTH_YR and LAST_NAME

If I do not use the alias, the column headings in Excel are NUMB_NAME, DAY_MTH_YR.

I want the order to still be Name of the person, Date of the transaction.

When I use the alias, it becomes Date of the transaction, Name of the person

The order changes.

How do I alias the columns without effecting the order of the columns.

I connect to the Oracle database and the result set is put into excel

RUN-TIME ERROR '1004' General OBDC Errror

gencom99 — Wed, 23 Sep 2009 08:55:52 GMT

Private Sub CommandButton1_Click()
Dim NumList As String
Dim SourceBook As Workbook
Dim ListSheet As Worksheet
Dim QuerySheet As Worksheet
Dim Query As QueryTable
Dim Numb As String
Set SourceBook = Application.ActiveWorkbook
Set ListSheet = SourceBook.Worksheets("Main")
Set QuerySheet = SourceBook.Worksheets("MONEY")
Numb = Range("H6")
If ListSheet.Cells(6, 8).Value = "" Then Exit Sub
NumList = "'" & ListSheet.Cells(6, 8).Value & "'"
Set Query = QuerySheet.QueryTables("MNY")
Query.Sql = "SELECT NUMB_TBLE.NUMB_NAME, TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'MONTH'), TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'YYYY'), SUM(NUMB_TBLE. PAY_IN), SUM(NUMB_TBLE. PAY_OUT), SUM(NUMB_TBLE. NET_PAY) "_
& "FROM JES.NUMB TBLE NUMB TBLE,
JES.NUMB_DATES_TBLE NUMB_DATES_TBLE" _
& "WHERE NUMB_TBLE.NUMB_ID = NUMB_DATES_TBLE.NUMB_ID AND NUMB_TBLE.NUMB_CODE IN (" & NumList & ") " _
& "Group by numb_tble.numb_name, TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'YYYY'), TO_CHAR(NUMB_DATES_TBLE.DAY_MTH_YR, 'MONTH')
Query.Refresh (False)
End Sub

When I add SUM(NUMB_TBLE. NET_PAY) to the code, I receive General ODBC error.

Before I add this code, the query works.

What is going on?

How do I fix it?

Run-Time Error '9' Subscript out of range

gencom99 — Sun, 20 Sep 2009 14:15:20 GMT

I am using a spreadsheet. It has two tabs MAIN and TOTAL CASH. On the MAIN tab is a BUTTON and a cell where to enter a number. After you put a number in the cell and click the button, the results of the query is in the tab TOTAL CASH

Private Sub CommandButton1_Click()
Dim NumList As String
Dim SourceBook As Workbook
Dim ListSheet As Worksheet
Dim QuerySheet As Worksheet
Dim Query As QueryTable
Dim Numb As String

Set SourceBook = Application.ActiveWorkbook
Set ListSheet = SourceBook.Worksheets("Main")
Set QuerySheet = SourceBook.Worksheets("TOTAL CASH")
Numb = Range("H6")

If ListSheet.Cells(6, 8).Value = "" Then Exit Sub
NumList = "'" & ListSheet.Cells(6, 8).Value & "'"

Set Query = QuerySheet.QueryTables("T_CASH")
Query.Sql = "SELECT CUST_TBLE.NAME, CASH_TBLE.SAV_AMT " _
& "FROM JES.CUST TBLE CUST TBLE,
JES.CASH_TBLE CASH_TBLE" _
& "WHERE CUST_TBLE.NUM_ID = CASH_TBLE.NUM_ID AND CUST_TBLE.NUM_CODE IN (" & NumList & ") "

Query.Refresh (False)

End Sub

This works.

In a new workbook, I created two tabs, MAIN and MONEY. On the MAIN tab is a BUTTON and a cell where to enter a number. After you put a number in the cell and click the button, I want the results of the query in the tab TOTAL CASH. This is not working. This code is very simiar to the code above that works. The only difference is the query. I am getting this error: run-time error '9'-- Subscript out of range. This is the line with the error:
Set Query = QuerySheet.QueryTables("MNY")

Why does one code work, and the other code does not?

This is the code that does not work.

Private Sub CommandButton1_Click()
Dim NumList As String
Dim SourceBook As Workbook
Dim ListSheet As Worksheet
Dim QuerySheet As Worksheet
Dim Query As QueryTable
Dim Numb As String

Set SourceBook = Application.ActiveWorkbook
Set ListSheet = SourceBook.Worksheets("Main")
Set QuerySheet = SourceBook.Worksheets("MONEY")
Numb = Range("H6")

If ListSheet.Cells(6, 8).Value = "" Then Exit Sub
NumList = "'" & ListSheet.Cells(6, 8).Value & "'"

Set Query = QuerySheet.QueryTables("MNY")
Query.Sql = "SELECT NUMB_TBLE.NUMB_NAME, extract(month from NUMB_DATES_TBLE.DAY_MTH_YR) " _
& "FROM JES.NUMB TBLE NUMB TBLE,
JES.NUMB_DATES_TBLE NUMB_DATES_TBLE" _
& "WHERE NUMB_TBLE.NUMB_ID = NUMB_DATES_TBLE.NUMB_ID AND NUMB_TBLE.NUMB_CODE IN (" & NumList & ") " _
& "Group by numb_tble.numb_name,
extract(month from NUMB_DATES_TBLE.DAY_MTH_YR)

Query.Refresh (False)

End Sub

Trouble with searching and displaying an array

Bill — Sat, 05 Sep 2009 20:51:22 GMT

Hey all, My name is Bill and i an a uni student. i am having trouble displaying the result of a search i am trying to put together.After clicking on the search button, my msgbox comes up saying that there are no matching record, but i know there is. the question is as follows:
Implement a search function so you can look up a part number in your table. Your search operation should return the result in a messageBox.

here is my code:

Public MyValue1 As String
Dim Formlength, looking As Integer
Public MyTable As Object

Public MyValue1 As String
Dim Formlength, looking As Integer
Public MyTable As Object

Private Sub Search_Button_Click()
Set MyTable = ActiveDocument.Tables(1)
Formlength = MyTable.Rows.Count
If looking > Formlength Then
'reset looking if not first search
looking = 1
End If
If looking = 0 Then
'initialize looking for the first search
looking = 1
End If
MyValue1 = Search_String_1.Value
'get the search string
If MyValue1 = "" Then
MsgBox ("You have not entered a partnumber to search for!")
Unload UserForm1
Set MyTable = Nothing
Exit Sub
End If
Set MyTable = ActiveDocument.Tables(1)
looking = looking + 1
'increment in case the search function was exited early
Call findit
End Sub
Public Sub findit()
While looking < Formlength + 1
'setup the loop
If MyValue1 = MyTable.Cell(looking, 1) Then
Debug.Print MyTable.Cell(looking, 1)
'if the search string is found in this cell
MyTable.Cell(looking, 1).Select
partnumberprint.Value = MyTable.Cell(looking, 1)
costprint.Value = MyTable.Cell(looking, 2)
quantityprint.Value = MyTable.Cell(looking, 3)
totalprint.Value = MyTable.Cell(looking, 4)
' print result in text box
Exit Sub
End If
looking = looking + 1
Wend
If looking > Formlength Then
MsgBox ("End of records! Your searched record has not been found.")
looking = Formlength
'looking reset so it will be initialized correctly in the next search
Unload UserForm1
End If
End Sub
End Sub

how do i put a custom label on a link when creating an outlook task?

tikboydev — Thu, 30 Jul 2009 02:39:15 GMT

hi... i'm relatively new to outlook task creation from visual basic. hope someone can help me... when i create an outlook task, i want to insert a link with a custom string... e.g. please see screenshot:

instead of the left screen, i would like to come up with the right screen. any help, tips or sample code would be highly appreciated... thank you very much in advance.

by the way, i'm using visual studio 2005, microsoft outlook 2003 and outlook interop from outlook 2003.

-------------------
Imports xOutlook = Microsoft.Office.Interop.Outlook

Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim xOutlookApp As New xOutlook.Application
Dim xNameSpace As xOutlook.NameSpace = xOutlookApp.GetNamespace("MAPI")
CreateTaskItem(xOutlookApp)
End Sub

Private Sub CreateTaskItem(ByRef xOutlookApp As xOutlook.Application)
Dim xNewTask As xOutlook.TaskItem = CType(xOutlookApp.CreateItem(xOutlook.OlItemType.olTaskItem), Microsoft.Office.Interop.Outlook.TaskItem)

xNewTask.Subject = "My Task " & Now.ToString
xNewTask.PercentComplete = 50
xNewTask.StartDate = Date.Now
xNewTask.DueDate = Date.Now.AddDays(5)
xNewTask.Status = Microsoft.Office.Interop.Outlook.OlTaskStatus.olTaskInProgress
xNewTask.Complete = False

'''' setting the task body
xNewTask.Body = "Click here to view google." _
& Environment.NewLine & Environment.NewLine _
& "Test... http://www.google.com"

xNewTask.Save()
End Sub

End Class
---------------

Word - VBA script to display text on form

Barry — Mon, 29 Jun 2009 12:45:09 GMT

I need to create a Word macro/vba script to display text to the right of a form field if a particular field value is select from the list of values. I currently have a script (Dropdown8 is a combo box, Text22 is a text box) that works (below), but only changes the text if, after changing the value in Dropdown8, you tab to another field and then reselect it a second time. Can someone help me to figure out what to do so that it(Text22) is updated each time the value in Dropdown8 is changed?

Code:

Sub Dropdown8_Click()
If ActiveDocument.FormFields("Dropdown8").Result = "Ogallala" Then 
ActiveDocument.FormFields("Text22").Result = "SAR Model Needed"
Else
ActiveDocument.FormFields("Text22").Result = " "
End If

Attachmate WRQ Reflection Programming

DavidJ_John — Tue, 09 Jun 2009 01:59:36 GMT

Hi,

I am working on WRQ reflection (For Unix and OpenVMS).

I am trying to copy a particular text content from a screen and write it into a word document.

Following is the code which is able to copy the entire contents into a word document.

Sub SendDisplayInfoToWord()
Dim displayText As String
With Session
'Get text from the screen display
'For Reflection for HP, UNIX and OpenVMS, RegGis Graphics:
displayText = .GetText(.ScreenTopRow, 0, _
.ScreenTopRow + .DisplayColumns, .DisplayColumns)
'For Reflection for IBM:
'displayText = .GetDisplayText(1, 1, _
'.DisplayColumns * .DisplayRows)
End With
'Create a Word object
Dim Word as Word.Application
Set Word = CreateObject("Word.Application")
'Make Word visible and create a new document
Word.Visible = True
Word.Documents.Add
'Add the display text to the document
Word.Selection.TypeText Text:=displayText
'Save the document and quit Word
Word.ActiveDocument.SaveAs Filename:="C:\MySample.doc"
Word.Quit
End Sub

How do I use it to get a particular content say only from a row Eg. contents from the 3rd row (3,1) to (3,10)?

Please help.

Regards,

David

Visual Basic Help!

damian1985 — Wed, 27 May 2009 09:17:00 GMT

I dont know where to start!

I work for a call centre and each advisor logs information during each call. I currently use a spreadsheet for each advisor each day and as you can imagine at the end of the week i have hundreds to go throught and produce a report from.

Does anyone have a template that i can amend which stores all this data for me and for me to then run a report to get the information i want/need. eg the advisor enters the information and for this to be saved somewhere.

As this will be available to hundreds of users i need a login page for each advisor to login to so i know its them.

Im very new to all this, could a program store/retreive information in excel templates.

I am using Microsoft Visual Basic Express Editions 2008 until im more confident in programming.......

Any help would be very much grateful and this will save me hours and hours of work each week printing off and going through spreadsheets!

Problem with Hyperlinks.Add

ferasferas — Sun, 10 May 2009 02:56:03 GMT

Derar evetybody

here is my code which copy an existting sheet and make a hyperlink to it in the main sheet with friendly name.
but when press the button of that form i always have a error messeage, and the compiler stope at the hyperlink line code.

the message tell am that the add mwthode for hyperlink is faild.

anyhelp


Private Sub cmdOKNewCust_Click() 
    Dim strCustName As String 
    Dim FirstPeriodSum As Double 
    Dim sbAdd As String 
    Dim scTip As String 
    Dim txToDsply As String 
    Dim Cust_Sheet_Name As String 
    Dim Cust_Number As Integer 
    Dim j As Integer 
    Dim i As Integer 
    Dim strReceipt As String, strGPhone As String, strMobile As String, strFax As String, strAddress As String 
     'Cust Name Check
    If txtCustName <> "" Then 
        strCustName = txtCustName 
    Else 
        MsgBox "No name", vbOKOnly, "try again" 
        txtCustName.SetFocus 
        Exit Sub 
    End If 
     
     'Fist Account
    If txtCustFirstPeriod = "" Then 
        FirstPeriodSum = 0 
    Else 
        FirstPeriodSum = txtCustFirstPeriod 
    End If 
    strReceipt = txtReceiptNum 
    strGPhone = txtCustGPhone 
    strMobile = txtCustMobile 
    strFax = txtCustFax 
    strAddress = txtCustAddress 
     '
    Application.ScreenUpdating = False 
     
     'Copy Cust Sheet
    Sheets("Cust").Copy After:=Sheets("Customers") 
     'change new sheet name
    Cust_Sheet_Name = "c" & Application.Sheets.Count + 1 
     
     'check new sheet name
    For j = 1 To ActiveWorkbook.Sheets.Count 
        If Cust_Sheet_Name = ActiveWorkbook.Sheets(j).Name Then 
            Cust_Sheet_Name = "c" & Application.Sheets.Count + Int(Rnd() * 10) 
            j = 1 
        End If 
    Next 
     'change sheet name
    ActiveSheet.Name = Cust_Sheet_Name 
     'fill some field
    ActiveSheet.Range("A5") = "Mr." & Trim(strCustName) 
    ActiveSheet.Range("B11").Value = FirstPeriodSum 
    ActiveSheet.Range("D11").Value = strReceipt 
    ActiveSheet.Range("E11").Value = "Bill" 
    ActiveSheet.Range("F11").Value = Format(Now(), "dd/mm/yyyy") 
     'First account border
    ActiveSheet.Range("b11:f11").Select 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .Weight = xlMedium 
        .ColorIndex = xlAutomatic 
    End With 
     
     '_____Customers Sheet_____
    Sheets("Customers").Activate 
    If Not IsNull(Sheets("Customers").Range("B500").End(xlUp)) Then 
        i = Sheets("Customers").Range("B500").End(xlUp).Offset(1, 0).Row 
    Else 
        i = Sheets("Customers").Range("B500").End(xlUp).Row 
    End If 
     '
    sbAdd = Cust_Sheet_Name & "!A5" 
    scTip = "Go to Ctstomer " & strCustName 
    txToDsply = strCustName 
     
    'the hyperlink
    With Application.Sheets("Customers") 
    .Hyperlinks.Add Anchor:=.Range("B" & i), Address:="", SubAddress:=sbAdd, ScreenTip:=scTip, TextToDisplay:=txToDsply 
    End With 
     
     
     'Cust Account past
    Sheets("Customers").Activate 
    ActiveSheet.Range("C" & i).Select 
    ActiveCell.Formula = "=" & Cust_Sheet_Name & "!$C$5" 
     'format the account
    With Selection.Font 
         '.Name = Arial
        .Size = 13 
        .Bold = True 
        .Underline = False 
        Selection.Style = "Comma" 
        Selection.NumberFormat = "_-* #,##0_-;_-* #,##0-;_-* ""-""??_-;_-@_-" 
    End With 
     
     'resotr customers sheet
    Call Cust_Names_Sort 
     
     'reFill the serial num
    Cust_Number = Sheets("Customers").Range("Customers_List").Count 
    i = 10 
    For j = 1 To Cust_Number 
        ActiveSheet.Range("A" & i).Value = j 
        i = i + 1 
    Next j 
     
     '_________ AlDaleel Sheet ________
    Sheets("Daleel").Activate 
    If Not IsNull(Sheets("Daleel").Range("B1000").End(xlUp)) Then 
        i = Sheets("Daleel").Range("B1000").End(xlUp).Offset(1, 0).Row 
    Else 
        i = Sheets("Daleel").Range("B10500").End(xlUp).Row 
    End If 
ActiveSheet.Range("A" & i).Value = "Ò" 
ActiveSheet.Range("B" & i).Value = strCustName 
ActiveSheet.Range("C" & i) = strGPhone 
ActiveSheet.Range("D" & i) = strMobile 
ActiveSheet.Range("E" & i) = strFax 
ActiveSheet.Range("F" & i) = strAddress 
'Resort al-daleel
    Call Sort_Phone 
     '
    Application.ScreenUpdating = True 
    Unload frmNewCust 
    Sheets(Cust_Sheet_Name).Activate 
    MsgBox "Add: " & vbCrLf & "Cust: " & strCustName & vbCrLf & "Successfuly", , "message" 
     'empty frmNewCust fields
    txtCustName = "" 
    txtCustFirstPeriod = "" 
    txtReceiptNum = "" 
    txtCustGPhone = "" 
    txtCustMobile = "" 
    txtCustFax = "" 
    txtCustAddress = "" 
End Sub

I'm using MS Excel 2007
and the unreadding text here that becouse of copy past and it's just string ""

Validate the Range

rajeshjm — Thu, 23 Apr 2009 05:49:12 GMT

I need a code for this statement

i created two text box. one for input and other for output

If the input value is between 1 to 10 (it means the value may be 1 or 2 or 3 or 4 etc.....) then it need to show "A" in output

similarly If the input value is between 11 to 20 then it need to show "B" in output

Thanks in advance for the code

Not able to update a Table using Access VBA

Arasi — Wed, 15 Apr 2009 08:07:58 GMT

Hi all,
I am a beginner in Access VBA.
I have an issue in updating a Table in the VBA code.

I am reading a text file in this VBA code and extracting the message IDs from the file and write some comment for the message ID.
I am trying to update the message ID and the comment to the Table "Result" using the below code. It is giving me Run time error - 3001. Invalid Argument.
it stops at the line Rslt.Updtae.

Dim db As Database
Dim Rslt As Recordset
Set db = CurrentDb()
Set Rslt = db.OpenRecordset("Result")
Rslt.AddNew
Rslt("Field1") = msg_id
Rslt("Field2") = comment
Rslt.Update

Please some one help me to overcome this. It was working fine before. Now its giving error. Donno where I ve gone wrong.

Thanks,
Arasi

VBA .enabled property use on Tab Control's "On Change" event

Barry — Mon, 13 Apr 2009 17:03:25 GMT

I have a Tab Control, "TabCt", which includes two Tabs (aka Pages) containing subforms(irrelevent though), "Tab1" and "Tab2".  This is on a main form, "Form1", which includes a text box "txtbox" (names for example only).  I would like to have the text box appear only when "Tab1" is selected/active, but not for "Tab2".  There are limited options in the event properties for tab controls, so I have chosen to run the code (below) based on the 'On Change' property.  Currently, based on the code below, the text box disappears when selecting either tab.  I am reaching out for help in adjusting my code (below) to work correctly.  I am wondering if possibly the code needs to be adjusted so that it is not tied to the 'On Change' tab control property as well, but I do not know how to adjust it so.  I read in Help that the Enabled Property applies to Tab Control groups (therefore I wonder if it cannot apply to individual tabs).Private Sub TabCt_Change()Dim txtbox As TextBoxSet txtbox= [Forms]![Form1]![txtbox]  'because it is on the main formIf Me!Tab2.Enabled Then    txtbox .Visible = False Else    txtbox.Visible = TrueEnd IfEnd Sub

Access Query not work

Aleon — Tue, 07 Apr 2009 11:17:35 GMT

All,

below is the Access 2003 Query, written for find out only those records where the employer name in "Data" Table is not Equal to Emplyer name in "CCM" table. but it not working pls Check & Correct it.

SELECT Data.CUSTOMER_NO, Data.CUSTOMERNAME, CCM.Category, Data.CONSTITUTION, CCM.EMPLOYERNAME, Data.BRANCH_NAME, Data.DECISION_Date
FROM Data, CCM
WHERE (((Data.EMPLOYERNAME)<>[ccm].[employername]))
GROUP BY Data.CUSTOMER_NO, Data.CUSTOMERNAME, CCM.Category, Data.CONSTITUTION, CCM.EMPLOYERNAME, Data.BRANCH_NAME, Data.DECISION_Date
HAVING (((Data.CONSTITUTION)<>"SALARIED CATEGORY C"));

Access 2003 - Code does not force equal values in two text boxes

Barry — Fri, 20 Mar 2009 11:30:10 GMT

I have converted a macro to VBA because I was getting an error message that "Echo=Off" or "Setwarnings=No" could neither suppress. I then changed the "On Error GoTo" line set to "0", which resolved the error message problem. Now, though, it does not force the Well Location value to equal that of the value in Comb box 34 (Combo34) any longer. Anyone know what I may add to the script (below) to force the Well Location value to equal what is visible (selected) in the combo box?

Function Forms_UpdateWellID()
On Error GoTo 0

DoCmd.Echo False, ""
DoCmd.SetWarnings False
' Updates new Well Location record in frmWellMaintenanceSub based on what is visible in Combo box 34
Forms!frmWellMaintenance!frmWellMaintenanceSub.Form![Well Location] = Forms!frmWellMaintenance!Combo34

Forms_UpdateWellID_Exit:
Exit Function

End Function

radio link design using a visual basic

forumstar — Wed, 25 Feb 2009 09:23:05 GMT

hi, everyone, actually i am doing a MSc Project based on visua basic 6, which is to design a radio link software. and, i am stucked in three things, which are-

1) how to create a link from one window to other(that is, from, form1 to other form)

2) how to keep the record of different values once calculated in a table

3) and, how to draw a graph in other window (which should be displayed once in a click from form1 to other)

ANY HELP WILL BE APPRECIATED............THANKS FOR YOUR TIME

Help me in my project

nader — Mon, 15 Oct 2007 09:11:20 GMT

Help me in my project

Runtime Error 5 - Call/Argument? VB noob!

tjruler — Thu, 19 Feb 2009 12:26:27 GMT

As this post will illustrate, I'm a total VBA noob. I've been trying to write an interative solver for a system of equations, using a 'do while...." loop. The program seems to disagree that my variable inputs are valid, I'm currently assigning variables from a spreadsheet using the 'range' function.

Currently the debugger flags the bolded line with Error 5 - Invalid Call or Argument

Any input very apprecaited, I'm stumped.

The Code
----------------------------------------------------------------------

Option Explicit
Sub Iterate_PEMU_Parameters()
'Iterative solver to solve equilibria equations; specifically designed for PEMU films

'Assign Variables
Dim Kp As Double, Ki As Double, Cs As Double 'Constants
Dim F As Double, P As Double, I As Double 'where X = Px, representing the polymers in different forms
Dim F0 As Double, P0 As Double, I0 As Double 'old values of above
Dim C As Double 'Concentration of Ions
Dim y As Double 'Activity Coefficient
Dim x As Double, z As Double 'Changes in Concentration
Dim h As Double, k As Double, o As Double 'Film Thickness, Swelling Constant, old thickness (h0)
Dim ConvergeFlag As Boolean 'Convergence Flag
Dim Counter As Double, OldCounter As Double 'Iteration Counter

'Retrieve Initial Inputs
Kp = Worksheets("Sheet1").Range("B1").Value
Ki = Worksheets("Sheet1").Range("B2").Value
Cs = Worksheets("Sheet1").Range("B3").Value
F = Worksheets("Sheet1").Range("B4").Value
P = Worksheets("Sheet1").Range("B5").Value
I = Worksheets("Sheet1").Range("B6").Value

ConvergeFlag = 0
Counter = 0

'Set h to 1
k = (F + I) / P
h = 1
o = 1

'Iterative Loop
Do While ConvergeFlag = 0

'Equations for one iteration
y = 10 ^ (-0.51 * Sqr(F + Cs))

x = (-(4 * y * F + P) - Sqr((4 * y * F + Kp) ^ 2 - 4 * (4 * y) * (y * (F ^ 2) - Kp * P))) / (2 * 4 * y)
If x < 0 Then
x = (-(4 * y * F + P) - Sqr((4 * y * F + Kp) ^ 2 - 4 * (4 * y) * (y * (F ^ 2) - Kp * P))) / (2 * 4 * y)
Else
End If

z = (-(-y * Cs - y * F - Ki) - Sqr((-y * Cs - y * F - Ki) ^ 2 - 4 * (y) * (y * F * Cs - Ki * I))) / (2 * y)
If z < 0 Then
z = (-(-y * Cs - y * F - Ki) + Sqr((-y * Cs - y * F - Ki) ^ 2 - 4 * (y) * (y * F * Cs - Ki * I))) / (2 * y)
Else
End If

'Store New Values
F = F + 2 * x - z
P = P - x
I = I + z

'Calculate new Thickness
o = h
h = k * (2 * P) / (F + I)

'Correct for Concentrations
F0 = F
F = F0 * (h / o)
P0 = P
P = P0 * (h / o)
I0 = I
I = I0 * (h / o)

'Convergence Test
If x < 0.0001 And y < 0.0001 Then ConvergeFlag = 1

'Count Iterations
OldCounter = Counter
Counter = OldCounter + 1

If Counter > 100000 Then
MsgBox "Iteration limit reached. Guess better next time, noob!", 48
ConvergeFlag = 1
End If

Loop

'Report Answers
Worksheets("sheet1").Range("D1").Value = ("Results")
Worksheets("sheet1").Range("D2").Value = ("Pf")
Worksheets("sheet1").Range("D3").Value = ("Pp")
Worksheets("sheet1").Range("D4").Value = ("Pi")
Worksheets("sheet1").Range("D5").Value = ("h")
Worksheets("sheet1").Range("D6").Value = ("y")
Worksheets("sheet1").Range("D7").Value = ("Ks")
Worksheets("sheet1").Range("D8").Value = ("Iterations")

Worksheets("sheet1").Range("E2").Value = F
Worksheets("sheet1").Range("E3").Value = P
Worksheets("sheet1").Range("E4").Value = I
Worksheets("sheet1").Range("E5").Value = h
Worksheets("sheet1").Range("E6").Value = y
Worksheets("sheet1").Range("E7").Value = k
Worksheets("sheet1").Range("E8").Value = Counter

End Sub

VB Code in Excel--formating with condition

krofox — Sun, 15 Feb 2009 12:08:11 GMT

i am be importing the data file from Web site . which are in a single column.

To make clear

2009,2,13,1,1,72.32
1) I need to place the data's in different column

2) here ......
First - year
Second - month
Third - date
Fourth - first hour of the day
Fifth - first five mins of the hour
Sixth - an integer value

3) Change the fifth column into actual mins

4) Fourth and Fifth column should look like....01:05 in a single column..

5) And every time the data refreshes ...it would come in the above format with the No:3 and No:4 condition.

example

2009,2,13,1,1,72.32
2009,2,13,1,2,75.45
would look like

2009| 2| 13| 1:05| 72.32|
2009| 2| 13| 1:10| 75.45|

Thanks ..

krofox

VBA Excel Convert the excel file into readonly by codes...

Krishal Rajput — Thu, 29 Jan 2009 14:28:09 GMT

Hello...... I am working on SQL Server 2000. I have a database that has almost 150 tables. I need to develop a report in excel. For this purpose i need to fetch data from my database and display the same in excel.

After doing this i need to ensure that no one can edit the data that i have fetched. So somehow i need to lock the grid of the excel sheet in which i have displayed the report result. Cant do this........What to do?

How to insert a set of particular rows ABOVE an active cell in MS-EXCEL ?

vamshi.bandi — Fri, 30 Jan 2009 00:29:03 GMT

Using the macro which inserts rows below the active cell..we will not be able to insert rows above the TOP MOST row...So it would be much helpful if we can insert rows above an active cell. Please let me know the macro by which we can insert rows above an active cell.

Thanks in advance!!!

Vamshi Bandi.

Word, VB.NET, section breaks

Johan Marais — Sat, 09 Aug 2008 12:16:09 GMT

I need to add a section break to a Word document to change from one column to two columns. The only break I find is a page break like

oWord.Selection.InsertBreak()

When I add the columns like this

oWord.Selection.PageSetup.TextColumns.SetCount(NumColumns:=2)

it changes the whole document to two columns, something I do not want. I understand that I need to add section break but how? Thanks for the help.

Sending a Mail merge from Mutilpe Email Accounts

KaosTheory — Mon, 27 Oct 2008 22:41:52 GMT

Hey All

I have a dilema. I currently have Outlook 2003 which has mutiple mailboxes. I have created a Macro in Word 2003 that sends out emails after i run a mail merge. Problem is I have multiple mailboxes and each mail merge needs to be sent from a different email account depending on a field in the mail merge.

Anyone have any idea how I how to send an email from a certain address.

EG: Merge field 'a' needs to be sent from email adress a@a.com and if merge field has 'b' in it then it needs to be sent from b@b.com

How do I get it to to send from these mailboxes as if it was from these fields and not "on behalf of"

Thanks

KaosTheory

Excel Addin Automation

Bradd — Thu, 25 Dec 2008 00:36:41 GMT

Hi Friends

Developing a addin for office using vb6. Already done with word and outlook but sort off stuck in Excel addin..

Problem is that i can't get the name of the file that i want to print..have tried getopenfilename and stuff but doesn't seem to work out..?

Hoping for some help from you guys..

Can definitely post some code if needed..

Creating a movable line

Wildrose — Mon, 13 Oct 2008 09:16:45 GMT

Hi,

I have to create a movable vertical line in a chart which consists of 3 graphs. the line should be movable from left to right and vice versa with regard to the x-axis.

Example: Let's say that the line is dragged on a particular value on the x-axis, the values of the y axis should be shown on each point of the graph.

How do i create such a movable line?

I hope you got me..

Using Application.Run to launch a macro in another workbook but processing halts when a msgbox comes up in that macro. How to continue processing automatically?

Catman — Wed, 19 Nov 2008 00:46:55 GMT

Here is a better explaination of the challenge I need help with. How do I get past the MsgBox "This is Book2" in an automated way?

In Workbook1:
Sub B1M1()
Application.Run "'" & "Book2.xls'!B2M1"
MsgBox "This is Book1, returned from Bk2"
End Sub

In Workbook2:
Sub B2M1()
MsgBox "This is Book2"
End Sub

From earlier post (FYI):

Just guessing but am looking at the RUN Method documentation (F1 in VB editor) and it shows how you can pass two variables, should I pass a SendKey to answer the MsgBox? Last last night I reported that processing was not passing back to the host workbook but I just tested this again and it is passing back.

How to interupt a progress bar

Catman — Wed, 12 Nov 2008 23:24:08 GMT

I have a splash screen that appears when Excel is opened. Normally it disappears after a few seconds and a progress bar shows time remaining. I want to be able to stop the splash screen from disappearing so I added a command button to the splashscreen (form) labeled "pause", if clicked I should temporarily stop the progress bar and allow the splashscreen to remain in view. Here’s what I have so far:

1. An Open event (for Workbook) brings the splashscreen into view:

Private Sub Workbook_Open()

SplashScreen.Show

End Sub

2. The form code (for splash screen) does this:

Private Sub UserForm_Activate()

Dim dTime As Date

Dim i As Integer

For i = 1 To 100 Step 15

dTime = Now + TimeValue("0:00:01")

Application.Wait TimeValue(dTime)

ProgressBar1.Value = i

Next i

Call EndSplash

End Sub

3. The For i loop delays the call of EndSplash for ~5 seconds. While the loop is executing I think I need to check the state of a command button to see if the user has clicked it (or not), just not sure how to do this. Well that's my though, maybe I am in left field and there is a better method, the main point is, how to temporarily stop the slash screen from dissapearing automatically. Appreciate any help and thanks in advance.

Aligning Text in a String for use in an EMail

BenjiB — Mon, 03 Nov 2008 09:39:13 GMT

I have a system designed arounf Outlook 2007 using VB6.
The system generates Email Confirmations to the clients which involve listing the products that they have purchased, e.g.

Description Qty Price Order Discounts Order Total
Product 1 1 12.39 No discounts on this item 12.39
Product 2 1 9.27 10% Discount Applied 9.27

etc etc etc.
This string is built up from a dataset using a combination of padded strings, e.g.

ProdDesc = Format(DatasetValue, "!@@@@@@@@@@@@@@@@@@@")
ProdPrice = Format(DatasetValue, "@@@@@@@")
etc etc
Email string = ProdDesc & ProdPrice ..... & vbcr

I end up with a string which does not line up.

I have also tried using fixed strings with vbtab but this also doe not always line up.

Anyone got any other ideas?

How to insert a set of particular rows under the active cell

sunilmulay — Sun, 05 Oct 2008 10:56:34 GMT

I'm a complete VBA newbie. I've got a worksheet where I want to allow the user to insert rows 101:106 above the active cell that the user selects. Using the below code, the macro pastes the rows below row 106, and not at the row the user selects....

What's the best way to fix this?

Sub InsertRowPlanning()
'
' InsertRowPlanning Macro
'
ActiveSheet.Unprotect Password:=PWORD
Rows("101:106").Select
Selection.Copy
ActiveCell.Select
Selection.Insert Shift:=xlDown
ActiveCell.EntireRow.Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:=PWORD
End Sub

Thanks in advance!

Sunil