First time posting on this website; mainly because I'm running into a huge issue with a question on my visual basic class that we were assigned. The full question can be seen here.
Basically, I'm running into issues where I THINK I am correctly executing the Buckling Load function as instructed, but I don't know how to get each different True or False value into the lstOut box.
Public Class Form1
Private Sub btnCompute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCompute.Click
Dim area As Double
Dim length As Double
Dim width As Double
Dim load As Double
Dim buckling1 As String
Dim buckling2 As String
Dim buckling3 As String
length = CDbl(txtIn.Text)
load = CDbl(txtLbs.Text)
buckling1 = Test1(load, length, 2, area)
buckling2 = Test1(load, length, 4, area)
buckling3 = Test1(load, length, 6, area)
End Sub
Private Function Test1(ByVal load As Double, ByVal length As Double, ByVal width As Double, ByVal area As Double) As Boolean
If ((0.3 * 1700000 * (length * width)) / (length / width) ^ 2) > load Then
Return True
Else
Return False
End If
End Function
End Class
And that's only the first part...I'm really struggling with this question. I'm somewhat new to programming, and the concept of functions are pretty frightening. Does anyone have any tips or advice they could give me?
Note that I'm not asking for the whole question to be completed, I'm just trying to figure out how I'm going to put all of output from the Test1, Test2, and Test3 functions into the lstOut box. I hope I'm making at least some sense.
You can set the buckling variables to Boolean as Suggested by Mark Hall, or pass the words "True" or "False" instead as string so that your Buckling variables accept them
IE simply add Double Quote(s) to True (turning it to "True") and False (turning it to "False")
Related
good morning all
I usually find the answer to my queries already on here but this one has me stumped. I have 3 tables,
area containing Area and Region, Phones comtaining phone number and IMSI (SIM number) and a log containing all 4 fields.
I've put in a Dlookup (as found on this site) on the log and although it works the first time the event is triggered it allways comes up with the wrong value. It's probably something stupid and simple, it's years since I used Access and that was probably Access 2007 or something.
Hope you can help. I have created a cut down test version but not sure how to add it to the question.
The VB code is here
Private Sub Area_Change()
Dim FoundRegion As String
FoundRegion = DLookup("[Region]", "[Area]", "'[Area]![Area]=[Area]'")
Me.Region = FoundRegion
End Sub
Private Sub Phone_Number_AfterUpdate()
Dim FoundIMSI As Double
FoundIMSI = DLookup("[IMSI ]", "[phones]", "'[phones]![Phone Number]=[Phone Number]'")
Me.IMSI = FoundIMSI
End Sub
not sure how to add the database
Private Sub Area_Change()
Dim FoundRegion As String
FoundRegion = DLookup("[Region]", "[Area]", "'[Area]![Area]=[Area]'")
Me.Region = FoundRegion
End Sub
Private Sub Phone_Number_AfterUpdate()
Dim FoundIMSI As Double
FoundIMSI = DLookup("[IMSI ]", "[phones]", "'[phones]![Phone Number]=[Phone Number]'")
Me.IMSI = FoundIMSI
End Sub
I'm working on an Access 2007 application and have some concerns about performance with MouseMove over labels and form.
So far with my solution I'm getting high cpu usage on a dual core I5 3.0ghz.
When I move the mouse cpu usage jumps to about 30-32% of one core.(With hyperthreading on)
For such a trivial task as a MouseMove, I'd like to have something a bit more efficient :)
The code below as been shortened; I have 8 labels with MouseMove event handler.
Here's how it's implemented:
Private moveOverOn As Boolean
Private Property Get isMoveOverOn() As Boolean
isMoveOverOn = moveOverOn
End Property
Private Property Let setMoveOverOn(value As Boolean)
moveOverOn = value
End Property
'label MouseMove detection
Private Sub lbl_projects_completed_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = 0 And isMoveOverOn = False Then
Me.lbl_projects_completed.FontBold = True
setMoveOverOn = True
End If
End Sub
'main form MouseMove detection
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If isMoveOverOn Then
resetBold 'call a sub that reset all labels .FontBold
setMoveOverOn = False
End If
End Sub
I don't know if it's possible, but I think that reducing the speed at which the MouseMove
is refreshed would help for this task, unfortunately I wasn't able to find information about it.
I'm opened to suggestions, thanks for your time! :)
The accdb format has hover and press color properties for buttons, so if you don't mind converting to that format and the labels could be buttons that should work much better than what you have going on.
Okay so this will do what you want with less of an expense but just know mouse move does not update X,Y when over a control so it has intermittent issues with the event.
This is custom implementation of a mouseHover event using mouse move on the detail section so it is only called 1 time. It then loops through the controls (you can change this loop to only look at controls you want) and sees if the cursor is within 5 twips of the control on any side
It also accepts a fuzziness parameter because of the lack of updating when over a control. The default it 50 twips. Also know that the controls should be shrunk to the minimum size possible to fit the data as this function uses the controls height and width to determine if you are inside of the control.
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
mouseHover X, Y
End Sub
Private Sub mouseHover(X As Single, Y As Single)
Dim ctrl As Control
'You may want to make an array of controls here to shorten the loop
'i.e.
' Dim ctrl_array() As Variant
' ctrl_array(0) = Me.lbl_projects_completed
' ctrl_array(1) = Me.some_other_label
' For Each ctrl in ctrl_array
For Each ctrl In Me.Controls
If ctrl.ControlType = acLabel Then
If FuzzyInsideControl(ctrl.top, ctrl.left, ctrl.width, ctrl.height, X, Y) Then
ctrl.FontBold = True
ctrl.ForeColor = RGB(255, 0, 0)
Exit For
Else
ctrl.ForeColor = RGB(0, 0, 0)
ctrl.FontBold = False
End If
End If
Next ctrl
End Sub
Private Function FuzzyInsideControl(top As Long, left As Long, width As Long, height As Long, X As Single, Y As Single, Optional fuzz As Integer = 50) As Boolean
Dim coord_left As Long
Dim coord_right As Long
Dim coord_top As Long
Dim coord_bottom As Long
Dim inside_x As Boolean
Dim inside_y As Boolean
coord_top = top - fuzz
coord_bottom = top + height + fuzz
coord_left = left - fuzz
coord_right = left + width + fuzz
inside_y = Y > coord_top And Y < coord_bottom
inside_x = X > coord_left And X < coord_right
FuzzyInsideControl = inside_x And inside_y
End Function
While I still think that this is unnecessary it was an interesting question and fun to work with but there are some of limitations due to how mouseMove works
Edit
Changed the FuzzyInsideControl function for a cleaner more concise version should be more accurate although I will have to test tomorrow when I get back to a computer with access.
Finally I found what I was looking for to reduce the MouseMove strain on the CPU:
'put this in head of the form code
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'form MouseMove with sleep timer
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'placeholder call sub to change the label FontBold Suggested by engineersmnky
Sleep (25)
End Sub
I am relatively new to Access though I do have some experience in VB, my question is probably very simple though I don't seem to know the terminology to search in order to find an answer I can use.
I am in the process of creating an "OnChange" event for a tab control I am using, I would like to pass an undetermined amount of integers to the function. IE:
=myFunction(1,4,6) OR =myFunction(ArrayList[1,2,4])
I would either create an overloaded function to work with these numbers, or if possible I would like to pass them as an array of integers. Though for the life of me I cannot figure out exactly how to do this. The reason I have taken this path is to make my function as universal as possible, basically just having to change what numbers I send to the function to change its behaviour.
This is some rough coding of what I am try to do, though I have no idea how to pass anything besides something like =myFunction([Form])
Public Function Refresh(tabsToCheck As ArrayList)
For Each o In tabsToCheck
If Me.DevForm.Value = o Then
RefreshAllForms
End If
Next o
End Function
Public Function RefreshAllForms()
Dim f As Form
For Each f In Access.Forms
f.Refresh
Next
End Function
Update
I thought I would update with my finalized code in case anyone needs this in the future thanks for your help!
Public Function RefreshControlTab(ctrl As Access.Control, ParamArray TabsToRefresh())
Dim i As Long
Dim lngUBound As Long
If UBound(TabsToRefresh) >= 0 Then
lngUBound = UBound(TabsToRefresh)
For i = 0 To lngUBound
If ctrl.Value = (TabsToRefresh(i) - 1) Then
RefreshAllForms
End If
Next
End If
End Function
Public Function RefreshAllForms()
Dim f As Form
For Each f In Access.Forms
f.Refresh
Next
End Function
So one change you would say '=RefreshControlTab([DevForm],3,4)' and when the 3rd or 4th tab is selected a refresh will be performed.
"I would like to pass some an undetermined amount of integers to the function."
That sounds like a ParamArray to me. See the simple function below. It will return the sum of a set of numbers.
Public Function AddThem(ParamArray MyNumbers()) As Long
Dim i As Long
Dim lngReturn As Long
Dim lngUBound As Long
If UBound(MyNumbers) >= 0 Then
lngUBound = UBound(MyNumbers)
For i = 0 To lngUBound
lngReturn = lngReturn + MyNumbers(i)
Next
End If
AddThem = lngReturn
End Function
Note the ParamArray is an array of Variant values. So within the function you would need to verify the values are numbers to avoid trouble ... one example of trouble would be a "type mismatch" error when calling the function with string values: AddThem("a", "b")
I'd like to use a .png as a custom icon in the Access 2007 ribbon.
Here's what I've tried so far:
I am able to load .bmp's and .jpg's as custom images without any problem. I can load .gif's, but it doesn't seem to preserve the transparency. I can't load .png's at all. I'd really like to use .png's to take advantage of the alpha-blending that is not available in the other formats.
I found a similar question on SO, but that just deals with loading custom icons of any kind. I am specifically interested in .png's. There is an answer from Albert Kallal to that question that links to a class module he had written that appears to do exactly what I want:
meRib("Button1").Picture = "HappyFace.png"
Unfortunately, the link in that answer is dead.
I also found this site which offers a download of a 460 line module full of dozens of API calls to get support for transparent icons. Before I go that route I wanted to ask the experts here if they know of a better way.
I know .png is pretty new-fangled and all, but I'm hoping the Office development folks slipped in some native support for the format.
Here is what I am currently using. Albert Kallal has a more full-fledged solution for Access 2007 ribbon programming that does a lot more than just load .png's. I am not using it yet, but it's worth checking out.
For those who are interested, here is the code that I am using. I believe this is pretty close to the minimum required for .png support. If there's anything extraneous here, let me know and I'll update my answer.
Add the following to a standard code module:
Option Compare Database
Option Explicit
'================================================================================
' Declarations required to load .png's in Ribbon
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, _
inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, _
hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, _
RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
'================================================================================
Public Sub GetRibbonImage(ctl As IRibbonControl, ByRef image)
Dim Path As String
Path = Application.CurrentProject.Path & "\Icons\" & ctl.Tag
Set image = LoadImage(Path)
End Sub
Private Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
uGdiInput.GdiplusVersion = 1
If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function
Private Function ConvertToIPicture(ByVal hPic As Long) As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic
End Function
Then, if you don't already have one, add a table named USysRibbons. (NOTE: Access treats this table as a system table, so you'll have to show those in your nav pane by going to Access Options --> Current Database --> Navigation Options and make sure 'Show System Objects' is checked.) Then add these attributes to your control tag:
getImage="GetRibbonImage" tag="Acq.png"
For example:
<button id="MyButtonID" label="Do Something" enabled="true" size="large"
getImage="GetRibbonImage" tag="MyIcon.png" onAction="MyPublicSub"/>
How do I do a search and replace of text within a module in Access from another module in access? I could not find this on Google.
FYI, I figured out how to delete a module programatically:
Call DoCmd.DeleteObject(acModule, modBase64)
I assume you mean how to do this programatically (otherwise it's just ctrl-h). Unless this is being done in the context of a VBE Add-In, it is rarely (if ever) a good idea. Self modifying code is often flagged by AV software an although access will let you do it, it's not really robust enough to handle it, and can lead to corruption problems etc. In addition, if you go with self modifying code you are preventing yourself from ever being able to use an MDE or even a project password. In other words, you will never be able to protect your code. It might be better if you let us know what problem you are trying to solve with self modifying code and see if a more reliable solution could be found.
After a lot of searching I found this code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function to Search for a String in a Code Module. It will return True if it is found and
'False if it is not. It has an optional parameter (NewString) that will allow you to
'replace the found text with the NewString. If NewString is not included in the call
'to the function, the function will only find the string not replace it.
'
'Created by Joe Kendall 02/07/2003
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SearchOrReplace(ByVal ModuleName As String, ByVal StringToFind As String, _
Optional ByVal NewString, Optional ByVal FindWholeWord = False, _
Optional ByVal MatchCase = False, Optional ByVal PatternSearch = False) As Boolean
Dim mdl As Module
Dim lSLine As Long
Dim lELine As Long
Dim lSCol As Long
Dim lECol As Long
Dim sLine As String
Dim lLineLen As Long
Dim lBefore As Long
Dim lAfter As Long
Dim sLeft As String
Dim sRight As String
Dim sNewLine As String
Set mdl = Modules(ModuleName)
If mdl.Find(StringToFind, lSLine, lSCol, lELine, lECol, FindWholeWord, _
MatchCase, PatternSearch) = True Then
If IsMissing(NewString) = False Then
' Store text of line containing string.
sLine = mdl.Lines(lSLine, Abs(lELine - lSLine) + 1)
' Determine length of line.
lLineLen = Len(sLine)
' Determine number of characters preceding search text.
lBefore = lSCol - 1
' Determine number of characters following search text.
lAfter = lLineLen - CInt(lECol - 1)
' Store characters to left of search text.
sLeft = Left$(sLine, lBefore)
' Store characters to right of search text.
sRight = Right$(sLine, lAfter)
' Construct string with replacement text.
sNewLine = sLeft & NewString & sRight
' Replace original line.
mdl.ReplaceLine lSLine, sNewLine
End If
SearchOrReplace = True
Else
SearchOrReplace = False
End If
Set mdl = Nothing
End Function
Check out the VBA object browser for the Access library. Under the Module object you can search the Module text as well as make replacements. Here is an simple example:
In Module1
Sub MyFirstSub()
MsgBox "This is a test"
End Sub
In Module2
Sub ChangeTextSub()
Dim i As Integer
With Application.Modules("Module1")
For i = 1 To .CountOfLines
If InStr(.Lines(i, 1), "This is a Test") > 0 Then
.ReplaceLine i, "Msgbox ""It worked!"""
End If
Next i
End With
End Sub
After running ChangeTextSub, MyFirstSub should read
Sub MyFirstSub()
MsgBox "It worked!"
End Sub
It's a pretty simple search but hopefully that can get you going.
additional for the function (looping through all the lines)
Public Function ReplaceWithLine(modulename As String, StringToFind As String, NewString As String)
Dim mdl As Module
Set mdl = Modules(modulename)
For x = 0 To mdl.CountOfLines
Call SearchOrReplace(modulename, StringToFind, NewString)
Next x
Set mdl = Nothing
End Function
Enjoy ^^