I have an image control on my form and I want the picture to change based on certain events. Let's say there are four different possible images. I know that I can set the control to whatever image I want using:
imgBox1.Picture = LoadPicture(sPath & "img1.bmp")
But I guess my question really is, do I have to use the LoadPicture function every time I want to change imgBox1 to a different picture (say, "img2.bmp")? Or can I load the four different images to some kind of object and then just set imgBox1.Picture to equal that object? I've tried several different ways and can't get anything to work.
StdPicture is the type to use to store an image.
The example below loads 3 images from disk once then cycles them on a button click.
Private mPics(2) As StdPicture
Private mIndex As Long
Private Sub Form_Load()
Set mPics(0) = LoadPicture("C:\kitty_born.bmp")
Set mPics(1) = LoadPicture("C:\kitty_life.bmp")
Set mPics(2) = LoadPicture("C:\kitty_dead.bmp")
End Sub
Private Sub someButton_Click()
If mIndex > UBound(mPics) Then mIndex = 0
Set somePictureOrImageBox.Picture = mPics(mIndex)
mIndex = (mIndex + 1)
End Sub
You could create a control array of Image/PictureBox controls, each holding one of the several images, and set their visibility depending on the image you want displayed at a time.
Alternativley, you could have a hidden control array of PictureBoxs and then use the PaintPicture method of the PictureBox you wish to change to paste in the desired image.
Related
I've created a program that is fully functional and I have sent it to some clients. Some of them have really old computers with really low resolution and they can't access it easily since the form and the controls are oversized for them. Is there an easy way for me to make it to automatically resize both form and controls according to the resolution?
As I've said in the title, this is for Visual Basic 6.0. Thanks to all of you in advance.
You can store size and location of each control on the form, and move or resize controls according to your needs.
In the code below, I use "TabIndex" property as unique id for each control (I can't remember in my old VB6 memory if that's the right thing to do...).
I store the size of the form, and the size and location of each control in the Form_Load event.
Private lWidth As Long
Private lHeight As Long
Private Enum ePROPERTY
ep_Top = 0
ep_Left = 1
ep_Width = 2
ep_Height = 3
End Enum
Private aControlSize() As Long
Private Sub Form_Load()
Dim ctlTmp As Control
lWidth = Me.Width
lHeight = Me.Height
ReDim aControlSize(3, Form1.Controls.Count)
For Each ctlTmp In Form1.Controls
aControlSize(ctlTmp.TabIndex, ep_Top) = ctlTmp.Top
aControlSize(ctlTmp.TabIndex, ep_Left) = ctlTmp.Left
aControlSize(ctlTmp.TabIndex, ep_Width) = ctlTmp.Width
aControlSize(ctlTmp.TabIndex, ep_Height) = ctlTmp.Height
Next
End Sub
Then each time the form is resized (Form_resize event), you'll have to move or resize each control.
Some of them need to be anchored to the right or to the bottom (or both). Some need to be resized and moved. Others don't need nothing.
Private Sub Form_Resize()
Dim ctlTmp As Control
For Each ctlTmp In Form1.Controls
Select Case LCase$(ctlTmp.Name)
Case "text1"
' Text1 is anchored to the left and right borders of the form :
ctlTmp.Width = Me.Width - (lWidth - aControlSize(ctlTmp.TabIndex, ep_Width))
Case "command1"
' Command1 is anchored to the right border of the form :
ctlTmp.Left = aControlSize(ctlTmp.TabIndex, ep_Left) - (lWidth - Me.Width)
Case "check1"
' check1 is anchored to the bottom border of the form :
ctlTmp.Top = aControlSize(ctlTmp.TabIndex, ep_Top) - (lHeight - Me.Height)
End Select
Next
End Sub
Form loaded :
Form Resized :
Please be advised that my code is largely perfectible...
There's probably a more elegant solution that goes through overload each Control and to add properties/methods like the existing ones in dotnet.
I'm looking to have my excel sheet with a split in it (vertically) ensuring a set of controls stay on the left of the screen for easy access. Currently Im using this code to select and move to a cell, based on a list of headings I have in the A column.
Option Explicit
Dim trimProcess() As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
If Not Intersect(ActiveCell, Range("A6:A1000")) Is Nothing Then
If ActiveCell.Value <> "" Then
For i = 0 To UBound(trimProcess)
If ActiveCell.Value = trimProcess(i) Then
Cells(4, 4 * (i + 1)).Select
Cells(4, 4 * (i + 1)).Activate
End If
Next
End If
End If
End Sub
This works fine for what I need, but it only works in the active split view IE if I click a cell in A in the left split, it moves the left split view. I want it so that the changes only the right view, but cant find the code to do so. Is this possible?
Background:
Entry is via a subform for adding/showing/linking images.
I do not want to store the image files within my DB, the image folder is separate. The DB will grow rather large in time.
I have created a click-control enabling a popup for user to browse and click on the imagePATH to be added in a Bound Textfield (called Bildadress, no not misspelled in My country, Grin ) in the subform.
See code below.
Then I add a new unbound Image-control and specify its Controlsource = the Textfield mentioned above.
For the firs image this works wonderful, but for the following the Image-control returns NULL (not show att all). The data in the Textfield updates as it should.
Will the 2nd stage only work in a 1:1 relationship OR can I (with your help) use VBA code to make this work?
OPTIMAL would be to get this to work and also a 2nd Bound Textfield just displaying the actual image file name. .
I hope someone out there have encountered this problem who also didnt want to use Attachment to store the files within the databae.
CODE:
Private Sub AddFilePath_Click()
Call Selectfile
End Sub
Public Function Selectfile() As String
Dim Fd As FileDialog
Set Fd = Application.FileDialog(msoFileDialogOpen)
With Fd
.AllowMultiSelect = False
.Title = "Välj önskad fil"
If .Show = True Then
Selectfile = .SelectedItems(1)
Me.Bildadress = Selectfile
Else
Exit Function
End If
End With
Set Fd = Nothing
End Function
If you use a bound textbox that holds the image-path then you can use
Me.Imagecontrol.Picture = Me.BoundTextControl.Value
to load the picture into an unbound image control. In your case that would be something like
If .Show = True Then
Me.Bildadress.value = .SelectedItems(1)
Me.Bild.Picture = Me.Bildadress.value
Else
It would be best to also load the respective picture in the OnCurrent Event.
Private Sub Form_Current()
Me.Bild.Picture = Me.Bildadress.value
End Sub
However, keep in mind that access is a one-file-database and you break that paradigm when using links to external files where the files would belong into the DB.
I would like to evauluate the value of a textbox report control and hide or display it based on its value, which I can achieve easily with VBA:
If Me.Fixed.Value = 0 Then
Me.Fixed.Visible = False
End If
That works fine, but the query I am using as the report's record source allows a range of records to be printed all at once (1 per page/report), and I want the above code to run for each page/report. I am unsure of where to put the code so that each record will play by the rules. Currently, if I choose a range of 8 records, only the first one does what I want, and as I navigate through the other records in the print preview screen the format of the report is remaining unchanged when it should be changing.
I have tried the following events:
Report:
On Current
On Load
On Got Focus
On Open
On Activate
On Page
Section:
On Format
On Print
On Paint
Where can I put my VBA so that each time I scroll through/navigate the range of records returned on that report my code runs?
You need to set the Visible property back to True as well, otherwise it will remain invisible.
I'm using the Format event of the Details section:
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
If Me.Fixed = 0 Then
Me.Fixed.Visible = False
Else
Me.Fixed.Visible = True
End If
End Sub
This works in Print Preview but not in Report View. There is probably a way to get this to work with the Report View, but I never use this view.
The statement can be simplified:
Me.Fixed.Visible = Not (Me.Fixed = 0)
Note that the Visible property is not available in the Detail_Paint() event, which is the event you need to use to have the conditional formatting apply in Report View. (Which might be required if you are trying to do something fancy such as simulated hyperlinks for a drill-down effect.)
A workaround is to set the ForeColor of the text box to equal the BackColor. Although the text is technically still there, it does not "show" on the displayed report, thus simulating a hidden field.
Private Sub Detail_Paint()
' Check for even numbers
If (txtID Mod 2 = 0) Then
txtID.ForeColor = vbBlack
Else
' Set to back color to simulate hidden or transparent.
' (Assuming we are using a Normal BackStyle)
txtID.ForeColor = txtID.BackColor
End If
End Sub
Example Output:
i have written some Macros for Visio. Now I copied these to a Stencil called Macros.vss
How can I call my Macros now?
It all depends on what the macros do and how you'd like to call them. I'm going to assume they're simply macros that will execute something within the active Visio page.
By default in Visio VBA, any public subs with no arguments get added to the Visio Tools->Macros menu, in a folder named by the document holding the macros (in this case Macros) and then separated into folders by module name. If you're the only person using the macros then you probably don't need to do anything else.
However, since you put them in a vss file I'll assume you'd like to distribute them to other people.
There's something funny (and by funny I mean irritating) about Visio and how toolbars and buttons work, when added programmatically. Unfortunately, when you create a toolbar using the UIObject and Toolbar and ToolbarItem classes, Visio is going to assume the code you're calling resides in the active drawing, and cannot be in a stencil. So I can give you a little guidance on using those classes, but basically it consists of distributing a .vst template along with your .vss files, with just a single required sub in the .vst file.
So, instead of using a custom toolbar, you can attach code to shape masters in your .vss file that execute the code when they get dropped on a drawing document (using CALLTHIS and the EventDrop event in the shapesheet). With this method I just have a sub that gets called using callthis that takes a shape object as an argument, executes some code, then deletes the shape (if I don't want it around anymore).
And lastly, you can manipulate the Visio UI programmatically to add a toolbar and buttons for your macros. Below is some sample code, basically the way I do it with a solution I developed. As I mentioned above, the most important part of using this method is to have a document template (.vst) that holds a sub (with the below code it must be named RunStencilMacro) that takes a string as an argument. This string should be the "DocumentName.ModuleName.SubName". This sub must take the DocumentName out of the string, and get a Document object handle to that document. Then it must do ExecuteLine on that document with the ModuleName.SubName portion. You'll have to step through the code and figure some things out, but once you get the hang of what's going on it should make sense.
I'm not sure of any other ways to execute the macros interactively with VBA. I think exe and COM addons may not have this issue with toolbars...
Private Sub ExampleUI()
Dim UI As Visio.UIObject
Dim ToolbarSet As Visio.ToolbarSet
Dim Toolbars As Visio.Toolbars
Dim Toolbar As Visio.Toolbar
Dim ToolbarItems As Visio.ToolbarItems
Dim ToolbarItem As Visio.ToolbarItem
Dim TotalToolBars As Integer
Dim Toolbarpos As Integer
Const ToolbarName = "My Toolbar"
' Get the UIObject object for the toolbars.
If Visio.Application.CustomToolbars Is Nothing Then
If Visio.ActiveDocument.CustomToolbars Is Nothing Then
Set UI = Visio.Application.BuiltInToolbars(0)
Else
Set UI = Visio.ActiveDocument.CustomToolbars
End If
Else
Set UI = Visio.Application.CustomToolbars
End If
Set ToolbarSet = UI.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Delete toolbar if it exists already
TotalToolBars = ToolbarSet.Toolbars.Count
For i = 1 To TotalToolBars
Set Toolbar = ToolbarSet.Toolbars.Item(i - 1)
If Toolbar.Caption = ToolbarName Then
Toolbar.Visible = False
Toolbar.Delete
Exit For
End If
Next
' create toolbar
Set Toolbar = ToolbarSet.Toolbars.Add
Toolbar.Caption = ToolbarName
Dim IconPos As Long ' counter to determine where to put a button in the toolbar
IconPos = IconPos + 1
Dim IconFunction As String
IconFunction = """Macros.Module1.SubName"""
Set ToolbarItem = Toolbar.ToolbarItems.AddAt(IconPos)
With ToolbarItem
.AddOnName = "RunStencilMacro """ & IconFunction & """"
.Caption = "Button 1"
.CntrlType = Visio.visCtrlTypeBUTTON
.Enabled = True
.state = Visio.visButtonUp
.Style = Visio.visButtonIcon
.Visible = True
.IconFileName ("16x16IconFullFilePath.ico")
End With
' Now establish the position of this toolbar
With Toolbar
.Position = visBarTop 'Top overall docking area
.Left = 0 'Puts it x pixels from the left
.RowIndex = 13
.Protection = visBarNoCustomize
Toolbar.Enabled = True
.Visible = True
End With
Visio.Application.SetCustomToolbars UI
Visio.ActiveDocument.SetCustomToolbars UI
End Sub