Thanks Gijsmo, it does the trick.
Merry Christmas & Happy 2022
Best regards,
Ludo
Thanks Gijsmo, it does the trick.
Merry Christmas & Happy 2022
Best regards,
Ludo
An example workbook would help. Which line errors?
It doesn't make sense declaring a variable for the CurrentRegion.
Hi Roy
Find an example workbook in the attachement.
It fails in following line:
.RemoveDuplicates Columns:=Array(ColumnNumbers), Header:=xlYes '<< Run-time error 13
Is also noted in my first question, last code example.
I use the currentregion to determine how many columns I have in the data file and use this number in the Case statement.
More info:
I work for the aviation bussiness and every cocpit monitor goes into a climate chamber where a temperature, power on/off & vibration is applied using a profile and creates a log file.
During this profele time (typical 4hours), a test program runs and create a log file.
After the profile is applied, I readout the minimum & maximum temperartures from the climate chamber log file AND the different temperatures from the test program.
Because every TYPE of monitor is different, the number of temperature sensors in the cocpit monitor is also variable.
Thats what you can see in my initial question, the upper code snipset. (35,36,37,38,39 & 45 columns).
The idea is to place those column numbers into the TYPE monitor configuration file so that the VBA code could be generic for any number of columns.
making it a lot easyer to configure this way than changing the VBA code.
Anyhow, thanks for looking at it.
best regards,
Ludo
Hi,
I'm writing data into an Excel workbook, after writing the data I'll check for duplicates and remove them if found.
For this purpose, I'm using the Range.RemoveDuplicates in my project but want it to be more flexible (Excel 2016).
As you can see below, I have different cases and columns to check for duplicates.
Everything is now hardcoded in the project, but like to prevent this and define the Columns array as a variable.
I retire by the end of next year, and If a new case is needed, it can give a problem for people not familiar with VBA.
See my test code on the bottom and can't get it working ( Run-time error 13).
It doesn't matter If i define the ColumnNumbers As Variant or as String
If I can get this up and running, then It don't need to be hardcoded in the project, and can I place the column numbers into a configuration file (variable).
Can this be done or not, or do i need a complete different approach to obtain the same result? If so, how to do it?
To all: Merry Christmas & Happy 2022
Best regards,
Ludo
'Original code snipset
'********************************************
'remove eventual duplicate entries
'we don't take the columns 5,7 & 8 into account
'********************************************
Set rngDataRange = .Cells(1, 1).CurrentRegion
With rngDataRange
Select Case .Cells(1, 1).CurrentRegion.Columns.Count
Case 35
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35), Header:=xlYes
Case 36 '
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36), Header:=xlYes
Case 37
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37), Header:=xlYes
Case 38 '
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38), Header:=xlYes
Case 39
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39), Header:=xlYes
Case 45
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45), Header:=xlYes
End Select
End With
Display More
Here below is my test code generating a Run-time error 13
Option Explicit
'TEST CODE
Sub testDuplicates()
Dim rngDataRange As Range
Dim v2 As Variant
Dim ColumnNumbers As Variant 'String
ColumnNumbers = "1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14"
Set rngDataRange = ActiveSheet.Cells(1, 1).CurrentRegion
With rngDataRange
Select Case .Cells(1, 1).CurrentRegion.Columns.Count
Case 11
.RemoveDuplicates Columns:=Array(ColumnNumbers), Header:=xlYes '<< Run-time error 13
'
End Select
End With
End Sub
'*******************************************************************************
Display More
Hi,
Hopefully I post it in the right forum.
I have a userform in a Word 2010 application with a webbrowser object in it.
Before i show this userform, i create the needed HTML code to open in the webbrowser.
The HTML code represent a labelsheet (A4), and the table rows & columns varry with the selected label sheet.
Obvious, this depends on the number of labels across and down on the label sheet.
In fact, it's only a table with a button in each table cell.
Because there's no Click event in the webbrowser object, I can't get its Row / Column value when I click in a table cell.
The probem i have is that i can't figure out what the HTML syntax is to run a subroutine from within the same userform.
The purpose is to retreive the table row & column number when i click a button.
the OnClick line give me always an error like:
Error 20 Permission denied
line: 45
char: 30
error: Expected ";"
code: 0
URL: .....
when i remove this line i don't get this error anymore.
I would appreciate it if anyone can help me to solve this problem.
here's part of the generated HTML code:
<!DOCTYPE html>
<html>
<head>
<style>
* {
padding: 0;
margin: 0;
}
body {
background-color: linen;
margin: 1em;
}
table tr td { text-align: center; }
/* Selected cell background = green */
table tr td.SelectedCell {
background-color: #4CAF50;
font-size: 1em;
color: Blue;
height: 24px;
width: 47px;
text-align: center;
border: 1px solid #FF0000;
}
/* Empty cell background = Gray */
table tr td.EmptyCell {
background-color: #808080;
font-size: 1em;
color: Red;
height: 24px;
width: 47px;
text-align: center;
border: 1px solid #FF0000;
}
</style>
</head>
<body>
<table>
<tr>
<td class= "SelectedCell">
<input type='button';
onClick='Application.Run "'New Label printer -6AB.docm'!StartHere.GetSelectedTableCellCoordinates"'; [B][COLOR=#FF0000]<<< Error here[/COLOR][/B]
class='button';
value=☺>
</td>
<td class= "EmptyCell">
<input type='button';
onClick='Application.Run "'New Label printer -6AB.docm'!StartHere.GetSelectedTableCellCoordinates"'; [B][COLOR=#FF0000]<<< Error here[/COLOR][/B]
class='button';
value=☹>
</td>
<td class= "EmptyCell">
<input type='button';
onClick='Application.Run "'New Label printer -6AB.docm'!StartHere.GetSelectedTableCellCoordinates"'; [B][COLOR=#FF0000]<<< Error here[/COLOR][/B]
class='button';
value=☹>
</td>
<td class= "EmptyCell">
<input type='button';
onClick='Application.Run "'New Label printer -6AB.docm'!StartHere.GetSelectedTableCellCoordinates"'; [B][COLOR=#FF0000]<<< Error here[/COLOR][/B]
class='button';
value=☹>
</td>
</tr>
Display More
and here's the test code from the Word subroutine that need to run when click on a button (need to be tuned).
Sub GetSelectedTableCellCoordinates()
'get the selected HTML table Row & Column values
'and place them in the apropriate textboxes
With frmLabelPosition
.tbRow = gintTableRow
.tbColumn = gintTableColumn
Debug.Print "Table Row = " & .tbRow
Debug.Print "Table Column = " & .tbColumn
End With
End Sub
Display More
Re: Selected item in listbox not highlighting
Quote from KjBox;795758One way is to do the following:
1. Use an unused cell on any sheet, make it a Named Range with the name "ListIndex", enter -1 in that cell ( you can set the font colour to the same as fill colour so that the value will not show).
2. Use this as the code that launches the user formCodeSub LoadForm() With UserForm1 '// Change name of user form to suit .lbPrinterList.ListIndex = Range("ListIndex") .Show End With End Sub
3. Use this as the lbPrinterList Click event code
Hi
Thanks for the answer.
Sorry for the late reply, I'm on holiday for the moment.
Will give it a try when back at work.
best regards,
Ludo
still searching for the Star ....
Hi,
I have a userfrom (Word 2010) with a listbox (lbPrinterList) and a command button (cmdClose).
In the Initialize event, i read the previous selectted listindex from the local registry.
I create a list of the the installed printers and
When running it the first time, I'll set the default listindex to -1 (nothing selected).
Then I create a list of installed printers and populate the listbox with it.
When I click then on a listitem (listbox click event ) I save the listbox listindex to the local registry.
Once i run the initialize event again i'll read the previous listindex back from the registry, but the listitem will not highlight, no matther what I try.
What am I doing wrong ?
Hope someone will bring up a solution.
Here's the full userform code + the printerlist code (source: Chip Pearson)
Best regards,
Ludo
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub lbPrinterList_Click()
If bInitializeUserForm = True Then Exit Sub
sSelectedPrinter = Me.lbPrinterList.List(Me.lbPrinterList.ListIndex)
'save selected printer list index to the local PC registry
SaveSetting AppName:=sAppName, Section:=sSECTION_PRINT, Key:=sKEY_DEFAULT_PRINTER, setting:=Me.lbPrinterList.ListIndex
'
Me.cmdClose.Enabled = True
End Sub
Private Sub lbPrinterList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
lbPrinterList_Click
Unload Me
End Sub
Private Sub lbPrinterList_Enter()
Me.lbPrinterList.BackColor = cYELLOW
End Sub
Private Sub lbPrinterList_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check if printer selected from printerlist
If Me.lbPrinterList.ListIndex <> -1 Then
sSelectedPrinter = Me.lbPrinterList.List(Me.lbPrinterList.ListIndex)
Me.lbPrinterList.BackColor = cWHITE
With Me.cmdClose
.Enabled = True
.SetFocus
End With
End If
End Sub
Private Sub UserForm_Initialize()
Dim lListIndex As Long
bInitializeUserForm = True
lListIndex = GetSetting(AppName:=sAppName, Section:=sSECTION_PRINT, Key:=sKEY_DEFAULT_PRINTER, Default:=-1)
If bDuplexPintDllFound = True Then
PrinterDuplex_ListPrinters
Else
CreateInstalledPrinterList
End If
'
With Me
'center userform on screen
.Left = (Application.UsableWidth - Me.Width) / 2
.Top = (Application.UsableHeight - Me.Height) / 2
.cmdClose.Enabled = False
End With
'highlight the selected printer in the listbox
With Me.lbPrinterList
.ListIndex = lListIndex 'GetSetting(AppName:=sAppName, Section:=sSECTION_PRINT, Key:=sKEY_DEFAULT_PRINTER, Default:=-1)
.Selected(lListIndex) = True
End With
bInitializeUserForm = False
'
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> vbFormCode Then
Cancel = True
bCancelPrinting = True
Else
bCancelPrinting = False
End If
End Sub
Sub CreateInstalledPrinterList()
'http://www.cpearson.com/excel/GetPrinters.aspx
'modified to show only the installed network printers
Dim Printers() As String
Dim NetworkPrintersOnly() As String
Dim N As Long
Dim s As String
Dim i As Long
Dim iRow As Integer
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
If Left(Printers(N), 1) = "\" Then
i = i + 1
ReDim Preserve NetworkPrintersOnly(i)
NetworkPrintersOnly(i) = Printers(N)
End If
Next N
frmSelectPrinter.lbPrinterList.List = NetworkPrintersOnly
End Sub
Display More
Re: Can't select Listbox selection
Hi,
it seems to be that i found the solution.
I need to use the Selected property of the listbox.
here's the code of the modified textbox events using the Selected property in the userform frmSelectLabels:
[code]
Private Sub tbSearchLocation_Change()
Dim lLocCount As Long 'number of warehouse locations in the listbox
Dim SearchCriteria As String 'search string
Dim iLength As Integer 'length of the search string
Dim L As Long 'counter
lLocCount = Me.ListBox1.ListCount 'lLocCount= the number of locations
With Me.tbSearchLocation
SearchCriteria = .Value
iLength = Len(.Value)
'if next character entered for search, reset the bMatchFound flag
If iSearchStringLenth < iLength Then
bMatchFound = False
End If
iSearchStringLenth = iLength 'save searchstring length for next search
.Value = UCase(.Value)
End With
'loop through the listbox for a match
For L = 0 To lLocCount - 1
If bMatchFound = True Then Exit Sub '24/03
With Me.ListBox1
If Left(.List(L), iLength) = SearchCriteria Then
.ListIndex = L 'highlight the match in the listbox
.Selected(L) = True
lMatchListIndex = L 'save the listindex
bMatchFound = True
End If
End With
Next
End Sub
Private Sub tbSearchLocation_Enter()
With Me.tbSearchLocation
.BackColor = cYellow
End With
End Sub
Private Sub tbSearchLocation_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.tbSearchLocation
.BackColor = vbWhite
End With
With Me.ListBox1
.Selected(lMatchListIndex) = True
End With
bMatchFound = True
End Sub
[\code]
and here's the code from the listbox events
[code]
Private Sub ListBox1_Change()
Dim lCntr As Long
Dim lCntr2 As Long
Dim lSelections As Long 'number of selected items in listbox (multi select)
Select Case PrintMode
'print single selection
Case Is = cPrintSingleLabel
ReDim Preserve sLocations(0)
'we get only the selection if an item from the listbox is selected
'then we enable the 'Verder' button.
With frmSelectLabels
If .ListBox1.ListIndex <> -1 Then
sLocations(0) = .ListBox1.List(frmSelectLabels.ListBox1.ListIndex)
.cmdNext.Enabled = True
End If
End With
'print selection
Case Is = cPrintSelection
For lCntr = 0 To frmSelectLabels.ListBox1.ListCount - 1
If frmSelectLabels.ListBox1.Selected(lCntr) = True Then
ReDim Preserve sLocations(lCntr2)
sLocations(lCntr2) = frmSelectLabels.ListBox1.List(lCntr)
lCntr2 = lCntr2 + 1
frmSelectLabels.cmdNext.Enabled = True
End If
Next
End Select
End Sub
Private Sub ListBox1_Enter()
If bMatchFound = True Then Exit Sub
With Me.ListBox1
.BackColor = cYellow
End With
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.ListBox1
.BackColor = cWhite
End With
bMatchFound = False
End Sub
[\code]
following variables are public
[code]
Public Const cYellow = &H80FFFF
Public Const cWhite = &H80000005
Public lMatchListIndex As Long 'listbox1 list index for search match
Public bMatchFound As Boolean 'True if a match found
[\code]
And the variable iSearchStringLenth is defined ON TOP of the userform frmSelectLabels.
[code]
Option Explicit
Dim iSearchStringLenth As Integer
[\code]
thanks for looking at it.
Ludo
Re: Can't select Listbox selection
O.K.
attached you'l find a derived EXEL file.
copied the code from Word to a Excel file.
the file 'Locaties.xlsx' contains the warehouse locations.
I reduced the list to 3000 locations instead of 6336 locations to get a smaller file size.
the file Warehouse locations2.xlsm is the 'application'
when you open this file in Excel, it adds a new tab called "Warehouse Labels" in the ribbon next to the Home tab.
click on the "Print Labels" button.
the code will check if the full path & filename to the file "Locaties.xlsx" exist in the local registry, if not, you have to place it in the upper textbox from the userform 'frmLabelLocFileName'.
place in the second textbox following string: alle lokaties in 1 file
this is the sheet name where the warehouse locations are read from (column F).
click save & close.
the code will import the label locations from the file 'Locaties.xlsx, sheet 'alle lokaties in 1 file'.
you can enter a search string in the 'Search Location' textbox. The listbox will follow the input from the textbox, but once you click on the highlighted item in the listbox, it shows the first 24 locations, and not the one selected.
to stop, click the close button.
don't try to print, because this code is still for use with Word.
thanks for looking at it.
best regards,
Ludo
Re: Can't select Listbox selection
Hi,
see my next post
Ludo
Hi,
I have a userform populated with over 6000 warehouse locations.
i added a textbox where i enter a warehouse location for easy lookup in the listbox.
when entering text, i'll search a match in the listbox.
so far so good.
there are 24 'locations' visible in the listbox.
problem start when a match found, and i click on the highlighted 'location' in the listbox, the listboxt start showing the locations from the first 'location' in the list, and not the selected one.
example: the match found is the 512 'location' in the list, but it shows 'location' 1 to 24 after I click on the 512-th item, or try to scroll down with the listbox scrollbar.
here's my code for the textbox where i enter the search string to look for in the listbox.
Private Sub tbSearchLocation_Change()
Dim lLocCount As Long
Dim SearchCriteria As String
Dim iLength As Integer
Dim sDummy As String
lLocCount = Me.ListBox1.ListCount 'lLocCount= the number of locations
With Me.tbSearchLocation
.Value = UCase(.Value)
SearchCriteria = .Value
iLength = Len(.Value)
End With
'loop through the listbox for a match
For l = 0 To lLocCount - 1
With Me.ListBox1
If Left(.List(l), iLength) = SearchCriteria Then
.ListIndex = l 'highlight the match in the listbox
bMatchFound = True
Exit Sub
End If
End With
Next
End Sub
Private Sub tbSearchLocation_Enter()
With Me.tbSearchLocation
.BackColor = cYellow
End With
End Sub
Private Sub tbSearchLocation_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.tbSearchLocation
.BackColor = vbWhite
End With
With Me.ListBox1
.BackColor = cYellow
.ListIndex = l
End With
bMatchFound = True
End Sub
Display More
and here's the code from the listbox.
Private Sub ListBox1_Change()
Dim lCntr As Long
Dim lCntr2 As Long
Dim lSelections As Long 'number of selected items in listbox (multi select)
Select Case PrintMode
Case Is = cPrintSingleLabel
ReDim Preserve sLocations(0)
'we get only the selection if an item from the listbox is selected
'then we enable the 'Next' button.
With frmSelectLabels
If .ListBox1.ListIndex <> -1 Then
sLocations(0) = .ListBox1.List(frmSelectLabels.ListBox1.ListIndex)
.cmdNext.Enabled = True
End If
End With
Case Is = cPrintSelection
For lCntr = 0 To frmSelectLabels.ListBox1.ListCount - 1
If frmSelectLabels.ListBox1.Selected(lCntr) = True Then
ReDim Preserve sLocations(lCntr2)
sLocations(lCntr2) = frmSelectLabels.ListBox1.List(lCntr)
lCntr2 = lCntr2 + 1
frmSelectLabels.cmdNext.Enabled = True
End If
Next
End Select
End Sub
Private Sub ListBox1_Enter()
If bMatchFound = True Then Exit Sub
With Me.ListBox1
.BackColor = cYellow
End With
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.ListBox1
.BackColor = cWhite
End With
bMatchFound = False
End Sub
Display More
what i like to obtain is, when i find a match, then click on the highlighted 'location' in the listbox (or scroll down with the listbox scrollbar), that the listbox doesn't get 'reset' to the first 'location' in the list.
the variables l and bMatchFound are Public.
I'm convinced that it can be done, just don't know how to get it working.
Any help welcome.
best regards,
Ludo
Re: Autozise textbox height for multirow input
Hi again,
I renamed the .ini file to .txt - works fine.
the XML file could be uploaded but there's a warning sign.
but i couldn't upload the .dotm file, even if i rename the .dotm file to .txt or .xls or whatever, it won't work.
i get following error message:
500[IOErrorEventtype = "ioError" bubbles=false cancelable=false eventphase=2 text= "Error #2038"]
so, I decided to make some re-arrangements in the userform, made the textbox a lot larger in height to be able to enter 8 text lines before the text disappears as described in previous messages.
I can live with this approach.
I did spent a few hours on this approch to see that it finally won't work at all.
I'm sorry for your lost time, but was convinced that it would be a nice approach, but the odds are against me.
anyhow, thanks a lot for reading the question and wanting to look at it.
I would say: issue closed.
best regards,
Ludo
Re: Autozise textbox height for multirow input
Hi,
thanks for the request, but i can't send you the file.
i need to confess that it's not a Excel workbook, but a Word Add-in (.dotm).
when trying to attach the file, i get a invalid file message (when i hoover over the RED exclamation mark)
note also that it need a second file, namely the description of custom labels.
reason i did ask it here is :
1) there's no specific WORD forum here (or i missed it)
2) because userforms and their objects behave identical in each OFFICE program (Word, Excel, Powerpoint, ..),.
are there any ideas where i have to look at?
Here are at least the Categorized Behaviour properties for the specific textbox:
AutoSize: False
AutoTab: False
AutoWordSelect: True
Enabled: True
EnterKeyBehaviour: False
HideSelection: True
IntegralHeight: True
Locked: False
MaxLength: 0
MultiLine: True
SelectioMargin: False
TabKeyBehaviour: False
TextAlign: 1 - fmTextAlignLeft
WordWrap: False
sorry if i mislead you.
anyhow thanks for the reply.
Ludo
Hi experts,
I do have a little problem to keep ALL the entered text visible in a textbox, setup for multiline input.
After initializing the userform, i have a textbox with a height of 20 and a font = Tahoma / Bold / size 10.
The width of the textbox = 186
After entering the first text line (3 characters for testing), i press the Ctrl + Enter key, so that i go to the next line (crlf).
Now i notice that the first line of text is moving a bit up, but still visible.
if I enter now the second line of text, the first entered text is completely moved up and no longer visible, even due to the fact that I enlarge the textbox heigth in the KeyDown event.
The more text lines i add the more likely that the second line also disapears from the textbox.
I tried to set the textbox Autosize to True, but it act the same. First line of text is moving up and no longer visible.
Is it uberhaupt possible to keep ALL the entered text in the textbox visible, and not moving up?
if so, how can it be done?
following code are the used events for this textbox:
Private Sub tbLabelText_Enter()
With Me
.tbLabelText.BackColor = cYellow
End With
End Sub
Private Sub tbLabelText_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me
.tbLabelText.BackColor = cWhite
sText = .tbLabelText.Text
.cmdFillLabels.Enabled = True
End With
End Sub
Private Sub tbLabelText_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'if multiline text, we enlarge the textbox height
If KeyCode = 13 Then
With Me
.tbLabelText.Height = .tbLabelText.Height + Int(.tbLabelText.Font.Size) + 1
End With
End If
End Sub
Display More
Best regards and thanks for any help.
Ludo
Re: Userform color to RGB values
@ Rory,
Thanks a lot for the fast reply.
it works great.
the returned values for the &H8000000F = 240,240,240 -> pritty close to the guessed 242,242,242 values.
pike,
Will read this too, thanks too for the link.
Best regards,
Ludo
Hi,
I'm looking for a way (function) to convert the userform back color(example: &H8000000F) to RGB values.
Reason is that i use sometimes a picture in a Userform button or Userform image.
VBA doesn't accept a PNG picture but a BMP.
BMP doesn't support tranparent colors, so i want to set the surrounding color (set as transparent color in GIF & PNG pictures) as close as the Userform backcolor, using Paint -> Edit Colors.
I guess there's more than the RGB values only in this value ,i count 8 digits, but every color is represented by 2 digits (Decimal :0 -> 255 = Hex: 00 to FF).
where are the remaining 2 digits used for?
Any help in this mystery of colors is appreciated.
For the moment, i'm just guessing the RGB values and use 242,242,242 .
it's pritty close the the wanted color, but i'm wondering if this could be calculated using a function.
Thanks for any help.
Best regards,
Ludo
Re: Write to .ini file fails - cause?
sorry for the post, it seems to be that i don't have permission on this folder.
So used that everything works imediately that i didn't think that there could be restrictions on the folder level.
Ludo
Re: Write to .ini file fails - cause?
Hi,
after some browsing on the net i found following code to return the error message string:
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Sub ShowLastError(sTyphoonManagerIniFullName As String, cSectionTyphoonManager As String, cKeyTyphoonManagerLastPRf As String, sPrfFileName As String)
Dim lngStatus As Long
Dim strMessage As String
strMessage = Space$(512)
lngStatus = SaveIniKey(sTyphoonManagerIniFullName, cSectionTyphoonManager, cKeyTyphoonManagerLastPRf, sPrfFileName) 'write new value into ini file
If lngStatus = 0 Then
lngStatus = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, strMessage, Len(strMessage), 0)
Debug.Print strMessage
End If
End Sub
Display More
the returned message is: Access is denied.
Any one a clue why the access is denied?
Thanks in advance.
Ludo
Hi,
I'm using for a while succesfull API calls to read/write to .ini files.
now i would like to manipulate a certain ini file, but it won't change the value after a SaveIniKey operation.
question now is what could cause this behaviour?
here's the code i use to read/write to the ini file
Public Function SaveIniKey(ByVal iniFileName As String, ByVal strSection As String, ByVal strKey As String, ByVal strValue As String) As Boolean
'save a value to a .ini file
Dim lngValid As Long
Dim WritePrivateProfileString32 As Boolean
On Error Resume Next
lngValid = WritePrivateProfileStringA(strSection, strKey, strValue, iniFileName)
If lngValid > 0 Then WritePrivateProfileString32 = True
On Error GoTo 0
End Function
'-------------------------------------------------
Sub ChangeTyphoonManagerIniFile(sTyphoonManagerIniFullName As String, cSectionTyphoonManager As String, cKeyTyphoonManagerLastPRf As String, sPrfFileName As String)
Dim sfName As String
sfName = sPrfFileName
Debug.Print GetIniKey(sTyphoonManagerIniFullName, cSectionTyphoonManager, cKeyTyphoonManagerLastPRf)
SaveIniKey sTyphoonManagerIniFullName, cSectionTyphoonManager, cKeyTyphoonManagerLastPRf, sfName 'write new value into ini file
Debug.Print GetIniKey(sTyphoonManagerIniFullName, cSectionTyphoonManager, cKeyTyphoonManagerLastPRf)
End Sub
Display More
As you can see, i use the same variables for reading & writing to the ini file, with the exeption of the sfName variable for writing.
sfName could be : \\Bvwsrv01\bvw\AV\Operations\HASS\6. Profiles\1. DU8x5\DU8x5_32G_V1_00.prf
The first Debug.Print line returns me: /X/Operations/HASS/6. Profiles/2. KDU1080_1500/Final_HASS_KDU1080_15G_V4_00.prf
the second Debug.Print line returns me the same string, even that the variable sPrfFileName = \\Bvwsrv01\bvw\AV\Operations\HASS\6. Profiles\1. DU8x5\DU8x5_32G_V1_00.prf
lngValid returns 0
the file attributes Hidden & Read-only arent NOTchecked.
here's a snipset of the ini file i want to manipulate:
[OVSconfig]
VibHighLim=100.000000
VibBackupLim=100.000000
OPCGroupWriteDelay=25.000000
ProfilePanelOpen=FALSE
LastPRF="/X/Operations/HASS/6. Profiles/2. KDU1080_1500/Final_HASS_KDU1080_15G_V4_00.prf" < need to change this line
PVChangeLim=30000.000000
CVStepSize=30.000000
LastLogFile="/C/Program Files/Typhoon Manager/LOG/KDU1080 25-08-2014 1.csv"
SoftwareVer="Typhoon Manager Software Version 5.03.02"
chksum=6B5175616C4D6172
SimMode=FALSE
Display More
Any idea why this isn't working?
Possible that any file attributes that prevent the file to change?
best regards,
Ludo
Re: Problem with Class module
Quote from S O;724065
Thanks for your reply.
I've also been looking around and this is what i have: my first working class module.
First mistake was that i placed my declaration of the classes above the API declaration
Changed it and needed to add the second class declaration too like:
Option Explicit
Option Private Module
Public Declare Function w32_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Const cDebug As Boolean = True 'TRUE for debug purpose, FALSE for runtime
'public custom Class modules
Public QualMarkProfile As clQMProfileSequences 'Declares QualMarkProfile as a clQMProfileSequences class = collection of clQMProfileSequence classes
Public QmSeq As clQMProfileSequence 'Declares QmSeq as a clQMProfileSequence class
Display More
the Continue button has now following code
Private Sub cmdContiniue_Click()
Dim sSelectedUnitName As String
'place selected unit type into sSelectedUnitName before we clear ALL other variables
sSelectedUnitName = sUnittype(0)
'Clear Public Variables
ClearPublicVariables
'reset the unit value in array location sUnittype(0)
sUnittype(0) = sSelectedUnitName
'
LoadIniFileSettings sSelectedUnitName
sPrfFileName = ""
sPrfFileName = ThisWorkbook.Sheets("definitie").Range("profilepath")
sPrfFileName = sPrfFileName & "\" & ThisWorkbook.Sheets("definitie").Range("profilename")
LoadPrfFile sPrfFileName
Set QualMarkProfile = New clQMProfileSequences
QualMarkProfile.CreateClassCollection
frmUnitData.Show
End Sub
Display More
and the class clQMProfileSequences has now following code in it
Option Explicit
Private c_ProfileSequences As Collection
Private mcTemplate As String
Private p_Name As String
Private Sub Class_Initialize()
Set c_ProfileSequences = New Collection
End Sub
Private Sub Class_Terminate()
Set c_ProfileSequences = Nothing
End Sub
Function NewEnum() As IUnknown
Set NewEnum = c_ProfileSequences.[_NewEnum]
End Function
Public Function Add(ByRef mPrfSeq As clQMProfileSequence)
c_ProfileSequences.Add mPrfSeq, mPrfSeq.Seq_Number_String
End Function
Sub CreateClassCollection()
'we fill the Class clQMProfileSequence with the profile Objects.
Dim lCntr As Long
Dim lLastRow As Long
Dim lRowOffset As Long
Const cSeqRowOffset As Integer = 28
Dim QmSeq As clQMProfileSequence
Dim wsPrfData As Worksheet
Set QualMarkProfile = New clQMProfileSequences
Set wsPrfData = ThisWorkbook.Sheets("Profile Data")
With wsPrfData 'ThisWorkbook.Worksheets("Profile Data")
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lCntr = 1 To lLastRow Step cSeqRowOffset
Set QmSeq = New clQMProfileSequence
QmSeq.Seq_Number_String = .Cells(lCntr, "A").Value
QmSeq.Seq_Type_String = .Cells(lCntr + 1, "A").Value
QmSeq.Dwell_Time_String = .Cells(lCntr + 5, "A").Value
QmSeq.Temp_In_String = .Cells(lCntr + 7, "A").Value
QmSeq.End_Temp_String = .Cells(lCntr + 8, "A").Value
QmSeq.Temp_Trans_Dur_String = .Cells(lCntr + 10, "A").Value
QmSeq.Start_Vib_String = .Cells(lCntr + 11, "A").Value
QmSeq.End_Vib_String = .Cells(lCntr + 12, "A").Value
QmSeq.Vib_Trans_Dur_String = .Cells(lCntr + 14, "A").Value
QmSeq.SSR_Value_String = .Cells(lCntr + 22, "A").Value
QmSeq.SSR_Index_String = .Cells(lCntr + 25, "A").Value
QmSeq.Last_SSR_String = .Cells(lCntr + 27, "A").Value
QualMarkProfile.Add QmSeq
Next lCntr
End With
End Sub
'more code follows in the clQMProfileSequences class
Display More
It works now as desired.
I know it's possible to put CreateClassCollection in the class initialize sub, but that's my next challenge.
I'm already happy that this one works.
Thanks for your remark, this was also a bug.
Best regards,
Ludo
Hi,
I'm trying to create my first class module(s).
First i got my Sub CreateClassCollection() routine in a regular module.
It worked perfect
Now i want to move it into the clQMProfileSequences class.
I have 2 classes, one called clQMProfileSequence, containing the individual data and a class clQMProfileSequences, containing the collection of clQMProfileSequence.
in a regular module i have following code on top before my subs:
Option Explicit
Option Private Module
Public QualMarkProfile As clQMProfileSequences 'Declares QualMarkProfile as a clQMProfileSequences class
I have also a userform with 3 buttons & a listbox.
when i click on the 'Continue' button, following code is executed where i want to 'populate' the class collection:
Private Sub cmdContiniue_Click()
Dim sSelectedUnitName As String
'place selected unit type into sSelectedUnitName before we clear ALL other variables
sSelectedUnitName = sUnittype(0)
'Clear Public Variables
ClearPublicVariables
'reset the unit value in array location sUnittype(0)
sUnittype(0) = sSelectedUnitName
'
LoadIniFileSettings sSelectedUnitName
sPrfFileName = ""
sPrfFileName = ThisWorkbook.Sheets("definitie").Range("profilepath")
sPrfFileName = sPrfFileName & "\" & ThisWorkbook.Sheets("definitie").Range("profilename")
LoadPrfFile sPrfFileName
Set QualMarkProfile = New clQMProfileSequences '<<<<<<<<<<<
QualMarkProfile.CreateClassCollection '<<<<<<<<<<<
frmUnitData.Show
End Sub
Display More
in my class module clQMProfileSequences (collection class module) i have following code:
Private c_ProfileSequences As Collection
Private mcTemplate As String
Private p_Name As String
'----------------------------------------------------------------
Private Sub Class_Initialize()
Set c_ProfileSequences = New Collection
End Sub
'----------------------------------------------------------------
Public Function Add(ByRef mPrfSeq As clQMProfileSequence)
c_ProfileSequences.Add mPrfSeq, mPrfSeq.Seq_Number_String
End Function
'-----------------------------------------------------------------
Sub CreateClassCollection()
'we fill the Class clQMProfileSequence with the profile Objects.
Dim lCntr As Long
Dim lLastRow As Long
Dim lRowOffset As Long
Const cSeqRowOffset As Integer = 28
Dim ThisSeq As clQMProfileSequence
Dim wsPrfData As Worksheet
Set QualMarkProfile = New clQMProfileSequences
Set wsPrfData = ThisWorkbook.Sheets("Profile Data")
With wsPrfData 'ThisWorkbook.Worksheets("Profile Data")
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lCntr = 1 To lLastRow Step cSeqRowOffset
Set ThisSeq = New clQMProfileSequence
ThisSeq.Seq_Number_String = .Cells(lCntr, "A").Value
ThisSeq.Seq_Type_String = .Cells(lCntr + 1, "A").Value
ThisSeq.Dwell_Time_String = .Cells(lCntr + 5, "A").Value
ThisSeq.Temp_In_String = .Cells(lCntr + 7, "A").Value
ThisSeq.End_Temp_String = .Cells(lCntr + 8, "A").Value
ThisSeq.Temp_Trans_Dur_String = .Cells(lCntr + 10, "A").Value
ThisSeq.Start_Vib_String = .Cells(lCntr + 11, "A").Value
ThisSeq.End_Vib_String = .Cells(lCntr + 12, "A").Value
ThisSeq.Vib_Trans_Dur_String = .Cells(lCntr + 14, "A").Value
ThisSeq.SSR_Value_String = .Cells(lCntr + 22, "A").Value
ThisSeq.SSR_Index_String = .Cells(lCntr + 25, "A").Value
ThisSeq.Last_SSR_String = .Cells(lCntr + 27, "A").Value
QualMarkSequences.Add ThisSeq '<< Compile Error: Variable not defined
Next lCntr
End With
' DON'T SET QualMarkSequences = Nothing, or we lose all Objects in our Class Module!
'do this only at the end when closing the app.
'like :
' Set QualMarkSequences = Nothing
End Sub
'more code follows
Display More
The problem i have is at the end where i Add the data to the QualMarkSequences.
gives me following error message: Compile Error: Variable not defined
Cause i'm new with Classes, i don't know what i'm doing wrong.
the idea behind it is that i can use the properties and functions like:
SequenceCount = QualMarkProfile.Count
ProfileTime = QualMarkProfile.ProfileTime
...
Anyone who can help me here?
Best regards,
Ludo