I am creating a chart, adding series on it, then I apply a data label to the last point of each series. I then run a routine which prevents overlaps from happening. In some conditions it works when I debug it however it does not work when I let it run normally. I think I have found the source of the error but don't know how to fix it.
First I apply data labels
'add data label to line
Worksheets(OutputSheetName).ChartObjects(1).Chart.SeriesCollection(x).Points(NumberOfSamples + 1).ApplyDataLabels
Worksheets(OutputSheetName).ChartObjects(1).Chart.SeriesCollection(x).Points(NumberOfSamples + 1).DataLabel.Text = Sheets(SheetName).Cells(PlotRow(x), TransistorNameY).Value & " " & Sheets(SheetName).Cells(PlotRow(x), DeviceTypeY).Value _
& " " & "[" & Sheets(SheetName).Cells(PlotRow(x), ColdCurrentY).Value & " " & "A" & "]"
'increasing data label width
Worksheets(OutputSheetName).ChartObjects(1).Chart.SeriesCollection(x).Points(NumberOfSamples + 1).DataLabel.Width = 200
Then I put data labels in an array.
Set sers = Worksheets(sh).ChartObjects(1).Chart.SeriesCollection
'if there are no plots on curve
If sers.Count = 0 Then
Exit Sub
End If
ReDim dLabels(1 To sers.Count)
For i = 1 To sers.Count
Set dLabels(i) = sers(i).Points(NumberOfSamples + 1).DataLabel
Debug.Print dLabels(i).Top
Next
When I look at the dLabels.Top using a watch, the value is correct. However when the dLabels.Top value is printed out in debug window the value does not match what is in the array. I have the dLabels array set as Datalabel
I then sort the top values going from highest first and start moving them to prevent overlap. Because of this when later I try to move the labels they are incorrect since they have wrong top position
Can anyone help? Not sure if this makes a difference but I do have a multi monitor setup.
Related
I'm facing a odd behavior by applying different colours within one cell via VBA.
In my case there are hundrets of cells within one column, showing different work-packages.
My vba code exaclty does what it should do, by coloring identified strings (respecively work packages) via looping through the cells and identifiying each work package via RegExp.
Here there is one extract that is doing the coloring job:
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = suchmuster
If .test(objWks_myTable.Cells(row_myTable, 20).Value) Then
Set RegMC = .Execute(objWks_myTable.Cells(row_myTable, 20).Value)
For Each RegM In RegMC
objWks_myTable.Cells(row_myTable, 20).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = vbOrange
Next
End If
End With
The issue appears as soon as I double click the cell after my makro run.
Then without any recognizable pattern, some characters are shown in a different color (mostly not only one character but a connected bunch of). In the picutre, the first cell shows the colours after my vba run, the second cell shows how it will immediately look like, if i double click it.
If I leave the edit mode via Escape, the original vba set colors will stay, If I leave the edit mode via Return, the undefined changes happen.
There are no formats nor format conditions set within the cells.
I really need somebodys help here. Would be great to find a solution!
Many Thanks !
This picture should show the issue:
Picture of the issue
I've found the issue.
First I tried also Instr instead of using a RegExp but the issue didn't disappear.
So I was investigating in my code that writes the strings into the cells.
And within that code I did the following:
dummy = dummy & " # " & z_trim(ctrl.Caption) & vbCrLf
ActiveCell.Value = dummy
The issue is because of vbCrLf
If I write the strings into the cells the following way, the changes within my coloring run are fixed, there is no change by entering the cell in edit mode:
dummy = dummy & " # " & z_trim(ctrl.Caption) & Chr(10)
ActiveCell.Value = dummy
Picture of fixed issue
It works, so I'm fine. But still interessted, why vbCrLf is causing such confusing thing?
I have an interface to cycle through XML child and edit them. Something like this:
The XML file looks as such:
<?xml version="1.0"?>
<catalog>
<query id="bk100">
<question>Do we have Docker security?</question>
<answer>Yes</answer>
<comment>None</comment>
<genre>Cloud</genre>
</query>
<query id="bk101">
<question>Do we have cloud security</question>
<answer>Yes</answer>
<comment>None</comment>
<genre>SCPC</genre>
</query>
<query id="bk100">
<question>Do we have Kubernetos security?</question>
<answer>Yes</answer>
<comment>None</comment>
<genre>Cloud</genre>
</query>
</catalog>
I am reading and storing the children as such in Global variabes:
xmlUrl = ThisWorkbook.Path & "\Blah.xml"
oXMLFile.Load (xmlUrl)
Set QuestionNodes = oXMLFile.SelectNodes("/catalog/query/question/text()")
Now once the user selects a Genre from the intrface (using a combobox or whatever), for example SCPC - I want the next and previous buttons to allow the to just loop through the questions and answers (and edit them) in the Genre SCPC
so for example, a Pseudo-implementation for the ``Next button` would look like:
'Next XML Node Iterartor
Private Sub btnNextEntry_Click()
Interate Where GenreNodes(i).NodeValue = "SCPC"
txtQuestion.Value = QuestionNodes(i).NodeValue
Pause 'When the user clicks Next again, the Next Node Data Is Showed
End Sub
and similarly something for the Previous button. Obviously I am out of logic here how to achieve this. As I also need to have editing and save functionality, I thought it was good idea to use index based iteration, but with the Genre based filtering, it doesn't make a lot of sense now and I am stuck.
Any tips ideas how I can handle this? Thanks.
Using Set QuestionNodes = oXMLFile.SelectNodes("/catalog/query/question/text()") for the question list makes it more difficult to filter than it needs to be. It's easier to use a list of the query nodes and then access the child nodes as required.
So, if you wanted to list all of the nodes then use:
Dim queryNodes As IXMLDOMNodeList
' ...
Set queryNodes = oXmlFile.SelectNodes("/catalog/query")
and you could then work with the values of the child nodes like this:
Dim node As IXMLDOMNode
For Each node In queryNodes
Debug.Print "Q: " & node.SelectSingleNode("question").Text & vbCrLf & _
"A: " & node.SelectSingleNode("answer").Text & vbCrLf & _
"C: " & node.SelectSingleNode("comment").Text & vbCrLf & _
"G: " & node.SelectSingleNode("genre").Text & vbCrLf & vbCrLf
Next node
If you then wanted to only work with nodes where the genre is "SCPC" then, it's just a case of changing the queryNodes list, like this:
Set queryNodes = oXmlFile.SelectNodes("/catalog/query[genre='SCPC']")
The code to access the child nodes doesn't change just because we have filtered the list differently. All of the changes are contained in how we create the queryNodes list. The code to update queryNodes could be called from the event handler for the combobox that allows the user to choose a genre.
We could adapt the code for printing all of the node values into a sub which prints the values of a specific node (as suggested by Tim Williams in the comments):
Sub printNode(node As IXMLDOMNode)
Debug.Print "Q: " & node.SelectSingleNode("question").Text & vbCrLf & _
"A: " & node.SelectSingleNode("answer").Text & vbCrLf & _
"C: " & node.SelectSingleNode("comment").Text & vbCrLf & _
"G: " & node.SelectSingleNode("genre").Text & vbCrLf & vbCrLf
End Sub
To control which node is displayed via your interface, use the Item property of the queryNodes list. The first node is queryNodes.Item(0), the next is queryNodes.Item(1) and so on.
If we use a variable called position to keep track of where we are in the list then the Previous button in your interface should make position = position - 1 and your Next button should make position = position + 1.
So, once the user presses Previous or Next, we would update position and then call printNode queryNodes.Item(position). There is always the chance that we have gone beyond either the start or the end of the list and this can be checked with If Not queryNodes.Item(position) Is Nothing before we try to call printNode.
For your specific case, you would need a sub to populate the fields in your interface. To do this, rename printNode to loadNode and, instead of printing to the Debug window, copy the relevant text from each child node into the corresponding field in your interface.
A saveNode function would just be the reverse of that - copy the value of each field in your interface into the text property of the relevant child node
I have the below VBA code and A and B are holding some strings. I want to concatenate these values with some other strings and store the result in a different cell, but I want only the strings in A and B to be formatted as bold and the rest as normal text.
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
' E.g.: A="currency", B="Small Int"
Worksheets("TestCases").Cells(i, 2) = "Verify the column " & A & " has same Data type " & B & " in code as well as Requirement document"
Expected output:
Verify the column currency has same Data type Small Int in code as well as Requirement document
Note: The values of A and B keep changing, so we cannot use the Characters() function.
Any help will be highly appreciated.
You can use the Characters() method - you just need to keep track of the length of the substrings. Personally, I would store the static strings in variables so that I can change them later without having to recalculate the indexes by hand:
' Untested
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
Dim S1 = "Verify the column "
Dim S2 = " has same Data type "
Dim S3 = " in code as well as Requirement document"
With Worksheets("TestCases").Cells(i, 2)
.Value = S1 & A & S2 & B & S3
.Characters(Len(S1), Len(A)).Font.Bold
.Characters(Len(S1)+Len(A)+Len(S2), Len(B)).Font.Bold
End With
The function to change the font style is:
[Cells/Cell range].Font.FontStyle = "Bold"
Therefore something like might work:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.FontStyle = "Bold"
You can also make things have underlines, strikethroughs etc... I found this really helpful blog post which goes through everything you should need to know:
http://software-solutions-online.com/excel-vba-formating-cells-and-ranges/#Jump4
I think you should have searched for this information yourself... Nevertheless this is the code that you should use to convert some cell data to bold:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.Bold = True
I am trying to build an organization chart automatically from data in Excel using Excel VBA. It works out fine, however, I would like to have both textframes filled in. In the big textframe I would like to have filled in the description of the department, and in the smaller textframe I would have like to add the department code.
smartart hierarchy layout
I can't find the code to access the smaller textframe.
Do While Source.Cells(Line, 1) <> ""
If Source.Cells(Line, 3) = PID Then
Set ParNode = QNode
If Source.Cells(Line, 4) = 1 Then
Set QNode = QNode.AddNode(msoSmartArtNodeDefault, msoSmartArtNodeTypeAssistant)
Else: Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
End If
QNode.TextFrame2.TextRange.Text = Cells(Line, 6)
'here something needs to be added !!!
CurPid = Source.Cells(Line, 2)
If Not Found Then Found = True 'something was find
'Source.Rows(Line).Delete
'Line = Line + 1
Call AddChildNodes(QNode, Source, CurPid)
Debug.Print ("CurPid" & CurPid)
Debug.Print ("line" & Line)
Set QNode = ParNode
'ElseIf Found Then 'it's sorted,so nothing else can be found
' Exit Do
'Else
End If
Line = Line + 1
Loop
the upper line (where your CEO-text is)
QNode.TextFrame2.TextRange.Text
***.SmartArt.AllNodes(...).Shapes(1).TextFrame2.TextRange.Text
the lower line where your smartart is empty:
***.SmartArt.AllNodes(...).Shapes(2).TextFrame2.TextRange.Text
you need to check if QNode.Shapes(2).TextFrame2.TextRange.Text works. if not, you may need to use .parent
I'm new to macros and vba in Excel. Currently, I'm working on a vba macro for an invoice template at work.
However, I'm running in a division by zero error that I'm having trouble tracing the cause of.
There are two specific lines of code where it pops up, sometimes..
First part:
VATRMB = 0
Second part:
VATRMB = VATRMB + (0.0593 * (ActiveSheet.Range("I" & i).Value / (1 + 0.0593)))
The Dim VATRMB is stored as follows:
Dim startRow As Integer, endRow As Integer, VATRMB As Single, VATEUR As Single, VATUSD As Single, VATRMBCell As Range, VATEURCell As Range, VATUSDCell As Range
The way I see it these lines should never throw up a division by zero error. In the first case there is no divisor whatsoever and in the second it is always positive.
Have any of you got an idea as to why this might cause an error? Could it have anything to do with the fact that the sub gets called multiple times, reusing the same VATRMB Dim? It should be reset after each call of the sub, right? Or could it have to do with the fact that I specify VATRMB as Single? This is appropriate for 'small' (sub-1,000,000) floating numbers, correct?
EDIT:
1. Added exact line used for calling Dim storage
2. Here is the full block of code used, maybe it helps to clarify a thing or two:
'Debug.Print Tab(10); ("Items will be searched in rows " & startRow & " thru " & endRow) 'Serves for debugging and testing
For i = startRow To endRow 'Loop the following code through all rows mentioned above
If ActiveSheet.Range("B" & i).Find("Membership") Is Nothing Then 'If nothing is returned when searching for "Membership"; i.e. if the item in this row is not a membership payment
If Not ActiveSheet.Range("H" & i).Find("RMB") Is Nothing Then 'If the value for this item is RMB denoted
'Debug.Print Tab(20); "Item on Row " & i & " is RMB denoted, VAT = " & ((ActiveSheet.Range("I" & i).Value / (1 + 0.0593)) * 0.0593) 'Serves for debugging and testing
VATRMB = VATRMB + (0.0593 * (ActiveSheet.Range("I" & i).Value / (1 + 0.0593))) 'Add row's VAT to VAT total
End If
If Not ActiveSheet.Range("H" & i).Find("EUR") Is Nothing Then 'If the value for this item is EUR denoted
'Debug.Print Tab(20); "Item on Row " & i & " is EUR denoted, VAT = " & ((ActiveSheet.Range("I" & i).Value / (1 + 0.0593)) * 0.0593) 'Serves for debugging and testing
'MsgBox VATEUR + 0.0593 * ActiveSheet.Range("I" & i).Value / (1 + 0.0593)
VATEUR = VATEUR + (0.0593 * (ActiveSheet.Range("I" & i).Value / (1 + 0.0593))) 'Add row's VAT to VAT total
End If
If Not ActiveSheet.Range("H" & i).Find("USD") Is Nothing Then 'If the value for this item is USD denoted
'Debug.Print Tab(20); "Item on Row " & i & " is USD denoted, VAT = " & ((ActiveSheet.Range("I" & i).Value / (1 + 0.0593)) * 0.0593) 'Serves for debugging and testing
VATUSD = VATUSD + (0.0593 * (ActiveSheet.Range("I" & i).Value / (1 + 0.0593))) 'Add row's VAT to VAT total
End If
Else 'Else, i.e. if the row contains a membership payment, then essentially nothing happens
'Debug.Print Tab(20); ("Item on Row " & i & " is a membership payment; no VAT paid.") 'Serves for debugging and testing
End If
Next
So what I'm trying to do is basically loop through all the items in the invoice, from startRow to endRow, and determine whether the item is a membership payment by parsing the 'type' string (column B). Then, depending on whether or not it is a membership payment determine the VAT, also checking the currency in which it is paid. The amount for the payment is stored in Column I as a floating number.
Not sure if this is the answer to your problems since you would need to provide the entirety of your workbooks etc to confirm. Nevertheless, we can create this type of "it should be impossible" situation with 100% reproducibility for not only Div0, but also for pretty much any error, with a line like:
VarX = 10 ' we can make this fail with Div0, Overflow or whatever
In our test, the problem is not actually the "direct" or "explicit" code where the error is reported, but rather, the error occurs elsewhere, and VBA in its infinite wisdom just happens to "report" the error in an odd way at an odd time (in fact it should not be reporting certain errors at all, see below).
Does your package involve any external executables, dll's, addins', etc?
If so, then that is likely the place to start.
If not, the error may actually be occurring directly or indirectly in the Range you are accessing, but not necessarily in the cell currently accessed.
Here is an example creating a "Div0" via a DLL accessed in VBA as an addin: Suppose you write a bit of code in another language, here Fortran (we use Implicit None everywhere, and everything is declared correctly etc.):
Pure Subroutine FortDLL(x, U)
:
Real(DP), Intent(In) :: x
Real(DP), Intent(Out) :: U
:
Real(DP) :: QQ
:
:
QQ = Log10(x) ! Notice this is not the return var and has nothing to do with anything on the VBA side (or so you would think)
:
U = 10.D0 ! Notice, this is the return var, and is a constant = 10.D0
:
End Subroutine FortDLL
compile as DLL and access in the usual way.
Then suppose you have some VBA as:
Function VBAFunc(x) as Variant
:
Call FortDLL(x, U)
:
Dim VarU as Variant
:
VarU = U ; you can replace this with VarU = 10, or whatever, and will get same result/failure
Now, if x < 0, then the DLL will crap out since Log10 is not defined for x < 0. This will throw a Fortran run time error, and depending on how you set this up, you can get it to throw a Div0, an Overflow (e.g. on the Fortran side the MaxExponent for a Double here is 1024, whereas on the VBA side it is around 308 depending on a number of things, etc. etc. etc. )
Now even though QQ has nothing at all to do with the VBA side, when the VBA code executes FortDLL(), it returns U = 10, and it actually does that part correctly.
HOWEVER, the DLL would have thrown a Div0 (or whatever you desire to create) error, and that "error message" is/can be buried in the return to the Call FortDLL().
If you are not using DLL's etc, it is possible that something comparable is happening in your "range" or elsewhere during you looping etc.
We have not performed explicit tests as to why the Dim as Currency "fix" works, but we are guessing that as Currency is a very special Type (it is actually a structured type with at least TWO fields), the "error message" may be buried in one of those "fields", and which may not be required/relevant to the size of number you are using, and obviating the crash by "fluke" (i.e. a kind of "lucky KLUDGE". You can test this by putting in numbers too large for Double, and requiring the full machinery of the Currency Type. If it is a "lucky KLUDGE", then one day when you are not around and somebody else is using your code, and they enter a number requiring the full Currency machinery, then it will likely crash, and nobody will know why.
Here is an alternate test, suppose you have the crash on a line like VarX = 10, then replace/amend as follows:
:
On Error Resume Next
VarX = 10
VarX = 10
:
... if this "works" (i.e. obviates the error/crash), then your problem is likely along the lines explained above (whether "external" or "internal"). In this case, basically, the "Div0 problem" is treated as a VBA error on the first time VarX is assigned 10, since the Error Trap is set, that "first time" catches and ignores the "DLL side error", and moves on.
... clearly this is just a TEST, not a solution.
This may also be Excel/Win/Compiler (and especially with GCC, compiler VERSION also since they have some pretty wacky things/changes sometimes) dependent and so the reproducibility and exact behaviour may vary.