form on access, create a control that add a record from the previous form - controls

The code is as follows but it does not work:
Private Sub Comando18_Click()
DoCmd.OpenForm "Msc_Assenza", acNormal, , , _
acReadOnly, , "codice fiscale"
End Sub
Sub Form_Open(Cancel As Integer)
Dim strEmployeeCF As String
strEmployeeCF = Forms!Msc_Assenza.OpenArgs
WhereCondition:= "Codice_fiscale" = & txtCodice_fiscale.Value
If Len(strEmployeeCF) > 0 Then
DoCmd.GoToControl "Etichetta1"
DoCmd.FindRecord strEmployeeCF, , True, , _
True, , True
End If
End Sub
hello everyone
I need some help with VBA.
these are my first times programming and unfortunately i don't know my way around.
I have a mask and I want to create a command that from the initial mask adds another record, but returning a value present in the initial mask and the rest of the fields empty as the Add New Record command already does.

Related

Inserting results of Hyperion Smart View VBA Function into list box and/or worksheet range

I've seen answers to questions similar to this one, but I haven't been able to find anything that addresses this exact situation.
Goal: Populate a list box and/or a worksheet with the output of a HypQueryMembers function. For example, I would like to get a list of the descendants of account 10100 without having to perform an ad hoc query and zoom in. I know how to get the return code, e.g. 0 if successful, but I want the actual output. I found some code that populated a list box, but I haven't been able to get it to work for me. I receive the error "Could not set the List property. Invalid property array index." My code follows:
Sub TestQueryMbrs()
Dim X As Integer
Dim arrAccounts
X = HypQueryMembers(Empty, "10100", HYP_DESCENDANTS, Empty, Empty, Empty, Empty, arrAccounts)
If X <> 0 Then
MsgBox "Unable to populate members." & vbCr & vbCr & "Error: " & X, vbCritical + vbOKOnly
Else
UserForm2.ListBox1.List = arrAccounts
UserForm2.Show
End If
End Sub
Any idea what I'm doing wrong? Also, I would like to accomplish the same thing, but populate a worksheet rather than a list box. But one step at a time!
Thanks!
Is 10100 the genuine name of the field? I suspect by you calling it account that 10100 should be replaced by Account instead as that parameter seems to be limited to the field name rather than an individual member. However, I have yet to determine how to get descendents of a particular account/cost centre so your way may be the correct way to do this.
I'd suggest trying that change to just "Account" though and then try adding as variant to Dim arrAccounts and then deleting Dim arrAccounts altogether if that doesn't work.
You may also not be able to populate the listbox before Userform2 is shown? You could wrap application.screenupdating =FALSE then TRUE around the Userform2 changes so the user doesn't see the list box being populated if there is a lag.
I had the same issue today and ran across this post - I realize it's years old...
Oracle's documentation on this function is a bit confusing... at least the example they used at the bottom of the page: https://docs.oracle.com/cd/E72988_01/DGSMV/ch12s15.html
For example, you need to enter the integer value for HYP_DESCENDANTS, which is 2 instead of the text shown in your code.
The following is a good snippet of code to verify your array:
Declare PtrSafe Function HypQueryMembers Lib "HsAddin" (ByVal vtSheetName As Variant, ByVal vtMemberName As Variant, ByVal vtPredicate As Variant, ByVal vtOption As Variant, ByVal vtDimensionName As Variant, ByVal vtInput1 As Variant, ByVal vtInput2 As Variant, ByRef vtMemberArray As Variant) As Long
Sub Example_HypQueryMembers()
sts = HypQueryMembers("INSERT WORKSHEET NAME HERE", "INSERT SMARTVIEW MEMBER HERE", 1, Empty, Empty, Empty, Empty, vArray)
If IsArray(vArray) Then
cbItems = UBound(vArray) + 1
MsgBox ("Number of elements = " + Str(cbItems))
For i = 0 To UBound(vArray)
MsgBox ("Member = " + vArray(i))
Next
Else
MsgBox ("Return Value = " + Str(vArray))
End If
End Sub

Optimize performance of Removing Hidden Rows in VBA

I am using the following code to remove hidden/filtered lines after applying autofilters to a big sheet in VBA (big means roughly 30,000 rows):
Sub RemoveHiddenRows()
Dim oRow As Range, rng As Range
Dim myRows As Range
With Sheets("Sheet3")
Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
If myRows Is Nothing Then Exit Sub
End With
For Each oRow In myRows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rng Is Nothing Then
Set rng = oRow
Else
Set rng = Union(rng, oRow)
End If
End If
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub
The code comes from here: Delete Hidden/Invisible Rows after Autofilter Excel VBA
Moreover I read this thread: Speeding Up Code that Removes Hidden Rows on a Sheet
The situation: I have applied 5 different filters to a table consisting of 12 columns, therefore a lot of rows are filtered out (hidden) after the process. When I try to delete those, the code above takes a very long time. In my case I don't know if Excel was still working, so I had to force an exit. That leads to the following question:
Is there any other way than looping through all the hidden rows and deleting them?
An idea which came to my mind was to copy only the remaining unfiltered (that is non-hidden) content to a new sheet and afterwards delete the old sheet, which contains the full information. If so, how can that be done?
I don't think you need to involve another worksheet. Simply copy the rows below the existing Range.CurrentRegion property and then remove the filter and delete the original data.
Sub RemoveHiddenRows()
With Sheets("Sheet10")
With .Cells(1, 1).CurrentRegion
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
If CBool(Application.Subtotal(103, .Columns(1))) Then
.Cells.Copy Destination:=.Cells(.Rows.Count + 1, 1)
End If
.AutoFilter
.Cells(1, 1).Resize(.Rows.Count, 1).EntireRow.Delete
End With
End With
End With
End Sub
You may also receive some good, focused help on this subject by posting on Code Review (Excel).
You can improve performance significantly with a function like this:
Option Explicit
Public Sub deleteHiddenRows(ByRef ws As Worksheet)
Dim rngData As Range, rngVisible As Range, rngHidden As Range
With ws
Set rngData = .UsedRange
With rngData
Set rngVisible = .SpecialCells(xlCellTypeVisible)
Set rngHidden = .Columns(1)
End With
End With
If Not (rngVisible Is Nothing) Then
ws.AutoFilterMode = False
' invert hidden / visible
rngHidden.Rows.Hidden = False
rngVisible.Rows.Hidden = True
' delete hidden and show visible
rngData.SpecialCells(xlCellTypeVisible).Delete
rngVisible.Rows.Hidden = False
End If
End Sub
I tested it on a file with 2 filters applied to it
The function was adapted from the code in this suggestion

Parse word document in VBScript

I got a weird mission from a friend, to parse through a bunch of Word files and write certain parts of them to a text file for further processing.
VBscript is not my cup of tea so I'm not sure how to fit the pieces together.
The documents look like this:
Header
A lot of not interesting text
Table
Header
More boring text
Table
I want to parse the documents and get all the headers and table of contents out of it. I'm stepping step through the document with
For Each wPara In wd.ActiveDocument.Paragraphs
And I think I know how to get the headers
If Left(wPara.Range.Style, Len("Heading")) = "Heading" Then
But I'm unsure of how to do the
Else if .. this paragraph belongs to a table..
So, any hint on how I could determine if a paragraph is part of a table or not would be nice.
Untested, because I have no access to MS Word right now.
Option Explicit
Dim FSO, Word, textfile, doc, para
' start Word instance, open doc ...
' start FileSystemObject instance, open textfile for output...
For Each para In doc.Paragraphs
If IsHeading(para) Or IsInTable(para) Then
SaveToFile(textfile, para)
End If
Next
Function IsHeading(para)
IsHeading = para.OutlineLevel < 10
End Function
Function IsInTable(para)
Dim p, dummy
IsInTable = False
Set p = para.Parent
' at some point p and p.Parent will both be the Word Application object
Do While p Is Not p.Parent
' dirty check: if p is a table, calling a table object method will work
On Error Resume Next
Set dummy = obj.Cell(1, 1)
If Err.Number = 0 Then
IsInTable = True
Exit Do
Else
Err.Clear
End If
On Error GoTo 0
Set p = p.Parent
Loop
End Function
Obviously SaveToFile is something you'd implement yourself.
Since "is in table" is naturally defined as "the object's parent is a table", this is a perfect situation to use recursion (deconstructed a little further):
Function IsInTable(para)
IsInTable = IsTable(para.Parent)
If Not (IsInTable Or para Is para.Parent) Then
IsInTable = IsInTable(para.Parent)
End If
End Function
Function IsTable(obj)
Dim dummy
On Error Resume Next
Set dummy = obj.Cell(1, 1)
IsTable = (Err.Number = 0)
Err.Clear
On Error GoTo 0
End Function

Copying table data continously in excel workbook

I have data in a tabular format range from A2:O30
I need to copy this table data by clicking a macro button into range Q2:A33 and so on
I used this code
Sub Button1_Click()
If Range("Q2").Value = "" Then
Range("Q2:AE33").Value = Range("A2:O33").Value
Else
Range("Q2:A33" & ActiveSheet.Rows.Count).End(xlUp) _
.Offset(0, 1).Value = Range("A2:O33").Value
End If
End Sub
It copies fine, but when i click on the button next time it shows me an error.
From the next time we pressed the button it should copy the table range next to AE i.e from AG2:AU33
It should copy continuously by clicking the button.
Thanks in Advance.
You have defined the range in the Else statement incorrectly. Also, use a range variable to save having to say Range("A2:O33") all the time - something like this:
Dim rngCopy as Range
Set rngCopy = Range("A2:O33")
Cells("A" & Activesheet.Rows.Count).End(xlUp).Offset(0, 1).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value

LotusScript - Setting element in for loop

I have an array set up
Dim managerList(1 To 50, 1 To 100) As String
what I am trying to do, is set the first, second, and third elements in the row
managerList(index,1) = tempManagerName
managerList(index,2) = tempIdeaNumber
managerList(index,3) = 1
But get an error when I try to do that saying that the object variable is not set. I maintain index as an integer, and the value corresponds to a single manager, but I can't seem to manually set the third element. The first and second elements set correctly.
On the flip side, I have the following code that will allow for the element to be set,
For x=1 To 50
If StrConv(tempManagerName,3) = managerList(x,1) Then
found = x
For y=3 to 100
If managerList(x,y) = "" Then
managerList(x,y) = tempIdeaNumber
Exit for
End If
Next
Exit For
End If
Next
It spins through the array (laterally) trying to find an empty element. Ideally I would like to set the index of the element the y variable is on into the 3rd element in the row, to keep a count of how many ideas are on the row.
What is the best way to keep a count like this? Any idea why I am getting a Object variable not set error when I try to manually set the element?
object variable not set means that you are trying to call methods or access properties on an un-initialized object. I don't see anything like that in the code snippets you have published, are you sure the error occurs in those lines?
A good way to pin-point errors is to include the module and line number in the error message. Add this around your subroutine to get a more detailed message:
Sub Initialize
On Error Goto errorthrower
//
// your code goes here...
//
Exit sub
ErrorThrower:
Error Err, Str$(Err) & " " & Error & Chr(13) + "Module: " & Cstr( Getthreadinfo(1) ) & ", Line: " & Cstr( Erl )
End sub
(I originally found this on Ferdy Christants blog)
It's not quite clear what problem you are trying to resolve here, but it looks like you have 1..50 "managers" that can have 1..100 "ideas" ? I'd make a class for managers instead:
Class manager
Private managername As String
Private ideas(1 To 100) As String
Sub new(managername As String)
Me.managername=managername
End Sub
// whatever methods you need....
End Class
Then, I'd keep track of them with a list of these objects:
Dim managerlist List As manager
Dim key As String
key = Strconv(tempmanagername,3)
if not iselement(managerlist(key)) then
set managerlist(key) = new manager(key)
end if
Dim currentmanager As manager
Set currentmanager = managerlist(key)
This is only an example to get you started, you will have to adapt this to solve your actual problem.

Resources