Re: Delete Value From Registry(permission)vb.net
[COLOR="Red"]I found it![/COLOR]
QuoteMijnSleutel = My.Computer.Registry.CurrentUser.OpenSubKey(Nsleutel)
I missed the argument in OpenSubKey to give write acces
so now it's working ....OpenSubKey(Nsleutel,true)
I have this code, but I get the error no write permission
How can I fix this or what is causing this
Imports Microsoft.Win32
Public Class Form1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Module Niveau Constanten Volgen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'De versie van XL in het register
Private Const mc_sSleutel_8a As String = _
"Software\Microsoft\Office\8.0\Excel\Options\"
Private Const mc_sSleutel_8b As String = _
"Software\Microsoft\Office\8.0\Excel\Add-in Manager\"
Private Const mc_sSleutel_9a As String = _
"Software\Microsoft\Office\9.0\Excel\Options\"
Private Const mc_sSleutel_9b As String = _
"Software\Microsoft\Office\9.0\Excel\Add-in Manager\"
Private Const mc_sSleutel_10a As String = _
"Software\Microsoft\Office\10.0\Excel\Options\"
Private Const mc_sSleutel_10b As String = _
"Software\Microsoft\Office\10.0\Excel\Add-in Manager\"
Private Const mc_sSleutel_11a As String = _
"Software\Microsoft\Office\11.0\Excel\Options\"
Private Const mc_sSleutel_11b As String = _
"Software\Microsoft\Office\11.0\Excel\Add-in Manager\"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim NwaardeTest As String
NwaardeTest = """Test.xla"""
If Not bVerwijderAddinUitOptions(NwaardeTest) Then _
MessageBox.Show("No value has been removed", "Value removed", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Public Function bVerwijderAddinUitOptions(ByVal NaamAddin As String) As Boolean
Dim MijnSleutel As RegistryKey
Dim Nsleutel As String
Dim NWaarde As String
Dim bWbestaat As Boolean = True
Dim bVerwijderd As Boolean = False
Dim i As Integer
Try
For i = 1 To 4
Select Case i
Case Is = 1 : Nsleutel = mc_sSleutel_8a
Case Is = 2 : Nsleutel = mc_sSleutel_9a
Case Is = 3 : Nsleutel = mc_sSleutel_10a
Case Is = 4 : Nsleutel = mc_sSleutel_11a
End Select
MijnSleutel = My.Computer.Registry.CurrentUser.OpenSubKey(Nsleutel)
If Not MijnSleutel Is Nothing Then Exit For
Next
i = 0
Do While bWbestaat
i = i + 1
NWaarde = "OPEN" & i
If My.Computer.Registry.GetValue("HKEY_CURRENT_USER\" & Nsleutel, _
NWaarde, Nothing) Is Nothing Then bWbestaat = False
If bWbestaat Then
If MijnSleutel.GetValue(NWaarde)= NaamAddin Then
MijnSleutel.DeleteValue(NWaarde, True)
bVerwijderd = True
End If
End If
Loop
Return bVerwijderd
Catch e As Exception
Return False
End Try
End FunctionTIA, Richard
Re: Addin Registry
Is the main addin located (where)? and where are the other files?
Or is it like setting a reference in the add-in manager to the folder that contains the main addin and then change the file extensions to make them invisible for the tools-addin dialog in XL.
How is the file again beiing recognized as an XLtemplate or whatever?
About the add-in manager in the registry
If I manually add a value to it, I can't see anything in XL
With or without a ValueValue for Value
The Value for ValueValue must be the path to the folder that contains the addin with Quotations surrounded, am I right?
Re: Addin Registry
thanks, Dennis
It is visual studio pro (creating an.exe file) that I use to distribute the files.
QuoteIf I understand it correctly You want to avoid a situation where some of Your XLAs are viewable via Excel's UI, i e in the add-in dialogform.
The main thing is, if I create more files for the application, whatever they might be in the future, I can keep them together in one location.
Aren't there any disadvantages in doing that(program the registry's addin manager), just to be shore?
What do you mean with changing the extension?
I'am not familiar with that
R
I need some comfirmation on this
Since my addin is expanded with multiple .XLT and logfiles
Is it also not a better idea to registrate the addin with installation from a VISTO.exe directly into
::HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Excel\Add-in Manager
because then I could have one location with al the files
Instead off the microsoft addins folder
Y work in combination with VISTO (already mentioned that)
Now I am kopying every file to the addins folder and the .XLT folder
I rather use statements like thisworkbook.path in Exel for adding my logfiles, otherwise they also appear in the Tools-addin list or I have to think off a folder to put them in. Everything gets sort off spread around then and thats not nice. I would like to keep everything in the installationfolder.
in summary: Registrate directly into the addin manager key
will work just as good as kopying it to the default addinmap
Am I right??
TIA, Richard
hi,all
Can somebody give me a headstart with this
With function below,I can find specific files with extension/name
The function returns an array
Now I need to sort them by date created
I'am thinking I should use the fso object and loop the firstfound array,
This is where it becomes somewhat difficult for me
Do I use a two dimensional array to store the information with the upperbound set to the upperbound of the firstfound array?
How can I sort this array.??
And then I would pass the array to a two column combobox I guess?
In summary: What is the best way to go about AND/OR how to sort ??
Public Function GetFileListArray(ByVal Pad As String, Optional ByVal _
Filter As String = "*.*", Optional strInFile As String = ".") As String()
Dim FolderFiles() As String
Dim strNBestand As String
strNBestand = Dir(Pad & Filter)
Do While strNBestand <> ""
If strNBestand <> "" And InStr(1, strNBestand, strInFile ) Then
ReDim Preserve FolderFiles(Count)
FolderFiles(Count) = strNBestand
Teller = Count+ 1
End If
strNBestand = Dir()
Loop
GetFileListArray= FolderFiles
End Function
Thanks, Richard
Re: Userform Control Blink
For me no, not especially
But I'got part of the code from somewhere
And I kept this part too
I changed it now too just load Form
I was also try 'ing to work with classes
But besides that, why would that code not work if I create a new instance
I was wondering about that
I could avoid such problems in the future then
R
Hello,all
a question:
This code works fine on a normal userform
But I declared the userform with "New" in my calling procedure
myForm as New formHow can I get it to work??
Or more interesting, why is it not working
Also what exactly is the advantage of using the keyword New
I have propertys set in the userform, but other than that..
Can someone tell me if the load function in this case is better or not
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
private sub cmd_click
call blink
end sub
Public Sub Blink()
Dim i As Long
For i = 1 To 20
' set color
Form.cmd.BackColor = &HFFFFFF
DoEvents
Call Sleep(60)
Form.cmd.BackColor = &HFF&
DoEvents
Call Sleep(60)
Next i
End SubTIA ,Richard
I have a problem
First, if I open de Txtfile on top of the procedure I get errors
So, I want to try open and closing them again depending on if statements
If someone can do it better, please help
Otherwise I need to know how to open it again and write after the last line
thanks,Richard ([COLOR="Red"]found it! "open for append")[/COLOR]
'''Bestaat uit vier evaluaties nRijen = 1 en nkols = 1
'nRijen = 1
'nKols <> 13
'overig als de eerste drie ONWAAR zijn
Sub ToonFdd()
Const gsTXT_RAPPORT As String = "\RapportTdk.txt"
Const nRijenMax As Long = 65536
Dim wksFormules As Worksheet
Dim nRij As Long, nKol As Integer
Dim nRijen As Long, nKols As Integer
Dim brkTabelStart As Range
Dim brkHuidigeTblStart As Range
Dim brkHuidigeTblStop As Range
Dim brkHuidigeRij As Range
Dim brkHeaders As Range
Set wksFormules = ActiveWorkbook.Sheets("Formules")
Set brkTabelStart = wksFormules.Range("VBATabelInkomsten")
Set brkHuidigeTblStart = brkTabelStart
Dim TxtBestand As String
Dim Data
gsAppDir = ThisWorkbook.Path
TxtBestand = gsAppDir & gsTXT_RAPPORT
Do While brkHuidigeTblStart.Row <> nRijenMax
Set brkHuidigeTblStop = brkHuidigeTblStart.End(xlDown)
nKols = WorksheetFunction.CountA(brkHuidigeTblStart.Rows.EntireRow)
nRijen = brkHuidigeTblStart.CurrentRegion.Rows.Count
Set brkHuidigeRij = brkHuidigeTblStart.Resize(1, nKols)
brkHuidigeRij.Select
brkHuidigeRij.Cells(1).Select
' Dit is een geheel nieuwe sectie, DUS ga weg.
If nRijen = 1 And nKols = 1 Then Exit Sub
If nRijen = 1 Then
Set brkHuidigeTblStop = brkHuidigeTblStart
Open TxtBestand For Output As #1
' Maak hier de titel
Data = brkHuidigeRij.Cells(1)
Write #1, Data
Write #1, ""
For nKol = 2 To nKols
' Data = brkHuidigeRij.Cells(1)
Data = MonthName(nKol - 1)
Write #1, Data;
Data = Application.Intersect(Columns(nKol), brkHuidigeRij)
If IsNumeric(Data) Then Data = Val(Data)
Write #1, Data;
Data = Application.Intersect(Columns(nKol), brkHuidigeRij).Formula
Write #1, Data;
Data = vbnulstring
Write #1, Data
Next
Close #1
Exit Sub
GoTo VolgendeTabel
End If
If nKols <> 13 Then
Debug.Print brkHuidigeRij.Cells(1) '//maak van deze de titel
For nRij = 1 To nRijen
For nKol = 1 To nKols
Debug.Print brkHuidigeRij.Offset(nRij).Cells(nKol)
Next
Next
GoTo VolgendeTabel
End If
Open TxtBestand For Output As #1
Data = brkHuidigeRij.Cells(1).Value '//maak van deze de titel
Write #1, Data
For nRij = 1 To nRijen - 1
Data = brkHuidigeRij.Offset(nRij).Cells(1)
Write #1, Data
Write #1, ""
For nKol = 2 To nKols
'//De betreffende maand
Data = Application.Intersect(Columns(nKol), brkHuidigeRij)
Write #1, Data;
'//De waarde in de cel
Data = Application.Intersect(Columns(nKol), brkHuidigeRij.Offset(1))
If IsNumeric(Data) Then Data = Val(Data)
Write #1, Data;
'//De formule in de cel
Data = Application.Intersect(Columns(nKol), brkHuidigeRij.Offset(1)).Formula
Write #1, Data;
Write #1, vbnulstring
Next
Next
Close #1
'Exit Sub
VolgendeTabel:
' Reset het startpunt naar de volgende deeltabel.
Set brkHuidigeTblStart = brkHuidigeTblStop.End(xlDown)
brkHuidigeTblStart.Select
Loop
End SubRe: Chart Is Stopping Custom Event Handler
can anybody on the forum delete this post
I was simply missing a variable,sorry
can someone solve this problem for me
I have a workbook with my own application event handler
I also have a button that first makes a chart as an object on the active sheet and shows it on a form.
What happens is this:
if I unprotect-/and protect, the sheet_change_event that has some code that unlocks and expands a table on the sheet depending on my input, won't work anymore. However the class that deals with these application_events is still active. (?myAPP is nothing)
It's got something todo with creating and deleting the chart
All the other forms that need to unprotect/protect don't have this problem.
What can I do to solve the problem??
Here is some code
Dim HuidigeGrafiek As Chart
Dim Bnaam As String
'Krijg de handle van het formulier, voor gebruik in de API's
Me.Caption = "Grafieken"
m_hWnd = FindWindow(vbNullString, Me.Caption)
Set HuidigeGrafiek = ActiveSheet.ChartObjects(1).Chart
' Sla de grafiek op als GIF
Bnaam = ThisWorkbook.Path & Application.pathSeparator & "temp.gif"
HuidigeGrafiek.Export Filename:=Bnaam, FilterName:="GIF"
ActiveSheet.ChartObjects(1).Delete
ActiveWorkbook.Worksheets("Data").Protect
' Toon de grafiek
Image1.Picture = LoadPicture(Bnaam)
Application.ScreenUpdating = True
Kill ThisWorkbook.Path & Application.pathSeparator & "temp.gif"
VerwijderXSluiten
Me.knpSluiten.Default = True
End Sub
Sub MaakEenGrafiek(r)
Dim wksFormules As Worksheet
Dim TijdelijkeGrafiek As Chart
Dim CatTitels As Range
Dim BronBereik As Range, BronGegevens As Range
Application.ScreenUpdating = False
gbNegeerEvents = True ' We willen niet dat de Sheet_Activate event onnodig uitgevoerd
' wordt. Zodoende wordt ook de fout vermeden omdat scrollrow
' niet ingesteld kan worden met een grafiekobject op het werkblad.
Set wksFormules = ActiveWorkbook.Worksheets("Formules")
With wksFormules
.Calculate
Set CatTitels = .Range("A5:M5")
Set BronBereik = .Range(.Cells(r, 1), .Cells(r, 13))
End With
Set BronGegevens = Union(CatTitels, BronBereik)
' Voeg een grafiek toe
Set TijdelijkeGrafiek = Charts.Add
' Pas de grafiek aan
With TijdelijkeGrafiek
.ChartType = xlColumnClustered
.SetSourceData Source:=BronGegevens, PlotBy:=xlRows
.HasLegend = False
.ChartTitle.Characters.Text = "Taxi inkomsten-/uitgaven"
.ChartTitle.Font.Size = 14
.ChartTitle.Font.Bold = True
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = "=Formules!R22C2:R22C13"
.SeriesCollection(2).Name = "Uitgaven"
.Axes(xlCategory).TickLabels.Font.Size = 10
.Axes(xlCategory).TickLabels.Orientation = xlHorizontal
ActiveWorkbook.Worksheets("Data").Unprotect
.Location Where:=xlLocationAsObject, Name:="Data"
End With
' Pas de grootte van het grafiefobject aan
With ActiveSheet.ChartObjects(1)
.Width = 300
.Height = 150
.Visible = False
End With
End Subthanks,
Richard
goodMorning,
I want to to check if a userform is active, but this line
makes that the forms's initialize_event is triggerd
if Fform.visible=true then...[COLOR="Red"]do something else[/COLOR]Is there a safe way to check for it??
or do you have to put it in a different sub :"TestIfActive":
and in the userform an if statement to check wich routine was this call originated from
By the way, what is the syntax to check from wich macro it was called from
something with caller??
t.i.adv, Richard
Re: Manage Addin Behaviour Via Registry
I found this code:
I also looked at Pearsons site, but that one is really long
I just need to set, delete,read the regkeys addin-manager and options
This code does not contain a procedure to set a new key, i think
I need code that will handle that
I want to control the behaviour if an addin is loaded at startup
Haven't figured out yet, wat to do with yhe key's; open, open1, open2, etc
Option Explicit
' Registry value type definitions
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_RESOURCE_LIST As Long = 8
Public Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_ALL_ACCESS As Long = &H3F
' Registry section definitions
Public Const HKEY_CURRENT_USER As Long = &H80000001
Private Const c_strKey_8a As String = _
"Software\Microsoft\Office\8.0\Excel\Options\"
Private Const c_strKey_8b As String = _
"Software\Microsoft\Office\8.0\Excel\Add-in Manager\"
Private Const c_strKey_9a As String = _
"Software\Microsoft\Office\9.0\Excel\Options\"
Private Const c_strKey_9b As String = _
"Software\Microsoft\Office\9.0\Excel\Add-in Manager\"
Private Const c_strKey_10a As String = _
"Software\Microsoft\Office\10.0\Excel\Options\"
Private Const c_strKey_10b As String = _
"Software\Microsoft\Office\10.0\Excel\Add-in Manager\"
Private Const c_strKey_11a As String = _
"Software\Microsoft\Office\11.0\Excel\Options\"
Private Const c_strKey_11b As String = _
"Software\Microsoft\Office\11.0\Excel\Add-in Manager\"
' Registry API functions
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal _
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal _
samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal _
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData _
As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As _
Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias _
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName _
As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
' Delete all registry keys that contain the named add-in
Public Function GetAllValues(strAddInName As String) As Single
Dim varTemp As Variant
Dim strKey As String
Dim strValue As String
Dim strValueData As String
Dim strSection As String
Dim strDelVal As String
Dim i As Long
Dim j As Long
Dim sngErrorCode As Single
On Error GoTo ErrHandler
For i = 1 To 8
Select Case i
Case Is = 1: strSection = c_strKey_8a
Case Is = 2: strSection = c_strKey_8b
Case Is = 3: strSection = c_strKey_9a
Case Is = 4: strSection = c_strKey_9b
Case Is = 5: strSection = c_strKey_10a
Case Is = 6: strSection = c_strKey_10b
Case Is = 7: strSection = c_strKey_11a
Case Is = 8: strSection = c_strKey_11b
End Select
j = 0
sngErrorCode = 10 ' Search through specified registry key
'Searches through the add-in key and locates the Map add-in if it _
exists, the value is then deleted
Do While Not (strValue = "Not Found")
varTemp = ReadRegistryGetAll(HKEY_CURRENT_USER, strSection, j)
j = j + 1
sngErrorCode = 20 ' Find which values are strings
If varTemp(0) = REG_SZ Then
strValue = varTemp(1)
strValueData = varTemp(2)
sngErrorCode = 30 ' Check if add-in is in the specified
Strings
If (InStr(strValue, strAddInName) > 0) Or _
(InStr(strValueData, strAddInName) > 0) Then
strDelVal = DeleteValue(HKEY_CURRENT_USER, strSection, _
strValue)
End If
End If
sngErrorCode = 40 ' Check if loop needs to be ended
If varTemp(0) = 0 Then Exit Do
Loop
Next i
sngErrorCode = 0
GetAllValues = sngErrorCode
Exit Function
ErrHandler:
GetAllValues = sngErrorCode
End Function
' Retrieves all the values from anywhere in the Registry under a given _
subkey, currently only returns string and double word values
Public Function ReadRegistryGetAll(ByVal lngGroup As Long, ByVal strSection _
As String, lngIndex As Long) As Variant
Dim lngResult As Long
Dim lngKeyValue As Long
Dim lngDataTypeValue As Long
Dim lngValueLength As Long
Dim lngValueNameLength As Long
Dim strValueName As String
Dim strValue As String
Dim dblTemp As Double
On Error Resume Next
lngResult = RegOpenKey(lngGroup, strSection, lngKeyValue)
strValue = Space$(2048)
strValueName = Space$(2048)
lngValueLength = Len(strValue)
lngValueNameLength = Len(strValueName)
lngResult = RegEnumValue(lngKeyValue, lngIndex, strValueName, _
lngValueNameLength, 0&, lngDataTypeValue, strValue, lngValueLength)
If (lngResult = 0) And (Err.Number = 0) Then
If lngDataTypeValue = REG_DWORD Then
dblTemp = Asc(Mid$(strValue, 1, 1)) + &H100& * Asc(Mid$(strValue, _
2, 1)) + &H10000 * Asc(Mid$(strValue, 3, 1)) + &H1000000 * _
CDbl(Asc(Mid$(strValue, 4, 1)))
strValue = Format$(dblTemp, "000")
End If
strValue = Left$(strValue, lngValueLength - 1)
strValueName = Left$(strValueName, lngValueNameLength)
Else
strValue = "Not Found"
End If
lngResult = RegCloseKey(lngKeyValue)
ReadRegistryGetAll = Array(lngDataTypeValue, strValueName, strValue)
End Function
' Deletes a specified key (and all its subkeys and values if on Win95) from _
the registry
Public Function DeleteValue(ByVal lngGroup As Long, ByVal strSection As _
String, ByVal strKey As String) As String
Dim lngResult As Long
Dim lngKeyValue As Long
On Error Resume Next
lngResult = RegOpenKey(lngGroup, strSection, lngKeyValue)
lngResult = RegDeleteValue(lngKeyValue, strKey)
lngResult = RegCloseKey(lngKeyValue)
End Function
' Set the data field of a value
Public Function SetKeyValue(lngPredefinedKey As Long, strKeyName As String, _
strValueName As String, varValueSetting As Variant, lngValueType As Long)
Dim lngRetVal As Long ' result of the SetValueEx function
Dim hKey As Long ' handle of open key
'open the specified key
lngRetVal = RegCreateKeyEx(lngPredefinedKey, strKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, lngRetVal)
lngRetVal = SetValueEx(hKey, strValueName, lngValueType, varValueSetting)
Call RegCloseKey(hKey)
End Function
' Set the data field of a value
Public Function SetValueEx(ByVal hKey As Long, strValueName As String, _
lngType As Long, varValue As Variant) As Long
Dim lngValue As Long
Dim strValue As String
Select Case lngType
Case REG_SZ
strValue = varValue
SetValueEx = RegSetValueExString(hKey, strValueName, 0&, _
lngType, strValue, Len(strValue))
Case REG_DWORD
lngValue = varValue
SetValueEx = RegSetValueExLong(hKey, strValueName, 0&, lngType, _
lngValue, 4)
End Select
End FunctionRichard
Re: Manage Addin Behaviour Via Registry
Quote from ByTheCringe2Moving this to Technical Issues forum.
That's a first
VBA questions are always technical aren't they??
and y always have issus
What does this mean??
Hello,
I have an addin with custom menu's etc
Is it possible to make a setting in the registry, so next time excel opens
the addin is not "marked" in the addins-list .
I can't do it manually because, because the close_event in the addin will be executed and that will screw things up.
Currently I'm looking at the regkeys: addin-manager and options, I see a change in the registry if I close XL when I unchecked an addin from the addin-list.
It looks promising, but Iám not familiar with it
Does anyone know
thanks, Richard
Re: Date Compare
Quote from Richnl"MM-YY" and "HH:MM"
hadd to be "dd-MM" and "HH:MM"
Re: Date Compare
thanks, but it diddn't work
It evaluates false agaih
I diddn't mention it before(because I diddn't noticed the obvious, but obviously the variable mijnDatum doesn't have the same problem.Only the time
causes it.
For clarity:
The columns with the range to find(mijnDatum and mijnTijd) are formatted respectivly:
"MM-YY" and "HH:MM"
Re: Date Compare
Here's a part, hope it makes it more clear
Private Sub CheckButton_Click()
Const sBron As String = "CheckButton_Click"
Dim mijnDatum As String, mijnTijd As String, blnBereikGevonden As Boolean
Dim strEerstGevonden As String
Dim brkZoeken2 As Range
Dim antw As Integer
On Error GoTo FoutAfhandeling
If Me.ListBox1.ListIndex = -1 Then Exit Sub
gbNegeerEvents = True
mijnDatum = Me.ListBox1.Value
mijnTijd = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
With wksCp
Set brkZoeken = .Range("A:A").Find(CDate(mijnDatum)) ' de waarde geselecteerd in de listbox.
If Not brkZoeken Is Nothing Then
strEerstGevonden = brkZoeken.Address
Do
If TimeValue(CDate(brkZoeken.Offset(0, 1))) = TimeValue(CDate(mijnTijd)) Then
MsgBox "U heeft geselecteerd:" & vbCrLf & vbCrLf & vbTab & brkZoeken & _
vbCrLf & vbTab & Format(mijnTijd, "HH:MM"), vbInformation + vbOKOnly, gsAPP_NAAM_T
If brkZoeken.Offset(0, 3).Value <> "a" Then
brkZoeken.Offset(0, 3).Value = "a"
brkZoeken.Offset(0, 3).Font.Name = "Marlett"
With wksData
.Unprotect
modCp.CP_WbTellerInstellen False, "CP_Nakijken"
.Protect
End With
End IfRe: Date Compare
thanks, I checked that, and yes it was dim myTime as string
I thought this was not a problem, also myTime holds the value of a listbox
That's a textvalue, not a date format
I'm confused now
I've got it to work with timevalue, but i'am not sure if this is the ideal way to do it
Maybe, later I run into some errors??
Richard
Does anyone have a quick solution for this
I have this code:
It compares a date from a listbox(myTime) to the date on a sheet
If y have my mouse above the code, they look like they are the same value
But it evaluates to false??
If CDate(rngFind.Offset(0, 1)) = CDate(myTime) Then...do something
or could this be the best solution:
If timevalue(CDate(rngFind.Offset(0, 1))) = timevalue(CDate(myTime))Then...do something
thanks, Richard