Re: [libreoffice-users] Confused with Macro results??

Take a look at these and read the comments. 

Sub StrSubTest
  Dim s As String
  Dim sNew As String
  Dim sNewDates As String
  
  sNewDates = "D1, D2"
  sNewDates = InputBox ("Please enter Date Cells Example D2,D1:")
  
  ' Assume for a moment that you do want to do a simple string substitution. 
  ' This will ONLY work if you are consistent on how "A2, A1" is represented in the string. 
  ' The code you sent, it was not consistent. It was "A2, A2", A2 ,A2", and others. 
  ' This example is consistent. 
  ' Two double quotes works as an embedded double quote, so: 
  s = "=IF(DATEDIF( A2, A1,""y""),IF(DATEDIF( A2, A1,""y"")=1,""1 Year "",DATEDIF( A2, A1,""y"")&"" 
Years ""),"""")&IF(MOD(DATEDIF(A2, A1 ,""m""),12),IF(MOD(DATEDIF( A2, A1,""m""),12)=1,""1 Month 
"",MOD(DATEDIF(A2, A1 ,""m""),12)&"" Months ""),"""")&IF(DATEDIF(A2, A1 ,""md""),IF(DATEDIF( A2, 
A1,""md"")=1,""1 Day "",DATEDIF(A2, A1,""md"")&"" Days""),"""")"

  ' You want to make a substitution. 
  ' This gives you the string of interest. 
  sNew = Replace(s, "A2, A1", sNewDates)
  Print sNew

  ' That said, what if you just do the entire calculation without using fancy dispatches. 
  ' Even easier, you could write a function that is called from Calc and pass in two dates. 
   Dim sDateCells()
   sDateCells = Split(sNewDates, ",")
   If UBound(sDateCells) <> 1 Then
     Print "Expected two dates"
     Exit Sub
   End If

  ' Get the current active sheet
   Dim oSheet
   oSheet = ThisComponent.CurrentController.getActiveSheet()
   Dim dCellValue1 As Date
   Dim dCellValue2 As Date
   Dim oCell1, oCe112
   dCellValue1 = oSheet.getCellRangeByName(Trim(sDateCells(0))).getValue()
   dCellValue2 = oSheet.getCellRangeByName(Trim(sDateCells(1))).getValue()
   
   Print MyFancyDateDiffString(dCellValue1, dCellValue2)
   

End Sub

' I could call this using: 
' =MYFANCYDATEDIFFSTRING(B3, C3)
' And I would get my answer. You would want to store the macro in the Standard library of either 
your macros
' or for the Calc document that calls it (because the standard library is always available without 
specifically loading it
Function MyFancyDateDiffString(d1 As Date, d2 As Date) As String
  Dim dFirst As Date
  Dim dLast As Date
  Dim dDateDiff As Date
  
  Dim iFirstYear As Integer
  Dim iLastYear As Integer
  
  If d1 < d2 Then 
    dFirst = d1
    dLast = d2
  Else
    dFirst = d2
    dLast = d1
  End If
  
  ' Convert dates to a double precision floating point number and then subract them.
  d = CDbl(dLast) - CDbl(dFirst)
  dDateDiff = dLast - dFirst

  ' This is where things get tricky. I can convert the date to a floating point number, 
  ' which gives me the number of days (as the whole portion of the number), but then I 
  ' need to worry about things such as leap years and similar. I could just be dumb about it
  ' and then truncate the answer or something like this: 
  ' Print Fix(cDbl(dDateDiff) / 365)
  ' The year function will get things mostly correct, but it assumes a specific starting point.
  ' I will not bother to look into this further, but I simply subtract 1900 and call it good for 
now. 
  ' I could get fancy and make checks to deal with "0 years", "0 months", or "0 days", but I won't. 
  MyFancyDateDiffString = "" & Year(dDateDiff) - 1900 & " years " & Month(dDateDiff) & " months " & 
Day(dDateDiff) & " days"
End Function

On Saturday, July 04, 2020 21:41 EDT, "Michael D. Setzer II" <msetzerii@gmail.com> wrote:
  Had a sheet that has two dates and calculate the difference between the dates.  
07/05/202004/11/196060 Years 2 Months 24 Days The formula being:=IF(DATEDIF( A2, 
A1,"y"),IF(DATEDIF( A2, A1,"y")=1,"1 Year ",DATEDIF( A2, A1,"y")&" Years "),"")&IF(MOD(DATEDIF(A2 
,A1 ,"m"),12),IF(MOD(DATEDIF( A2, A1,"m"),12)=1,"1 Month ",MOD(DATEDIF(A2 ,A1 ,"m"),12)&" Months 
"),"")&IF(DATEDIF(A2 ,A1 ,"md"),IF(DATEDIF( A2, A1,"md")=1,"1 Day ",DATEDIF(A2 ,A1 ,"md")&" 
Days"),"") That excludes years months and days if value of unit is 0, and also makes the context 
singular if value is 1. Short version that just puts the values is:=DATEDIF( A2, A1,"y")&" Years 
"&MOD(DATEDIF( A2, A1,"m"),12)&" Months "&DATEDIF(A2 ,A1 ,"md")&" Days" Originally wanted to just 
copy the formula, and change the A2,A1 to the new values. Recording it worked just fine, and did 
everything correctly in the recording process, but the play back didn't include the last steps 
using the F2 key. I've just now done a new version that does seem to work, but it made the process 
a lot longer... Was a mess getting all the "s correct, but it seems to work the way I want, just 
required manually replacing each value versus using the search and replace substitute command?? sub 
Z3rem ----------------------------------------------------------------------rem define variablesdim 
document   as objectdim dispatcher as objectrem 
----------------------------------------------------------------------rem get access to the 
documentdocument   = ThisComponent.CurrentController.Framedispatcher = 
createUnoService("com.sun.star.frame.DispatchHelper") rem 
----------------------------------------------------------------------dim sText sText = InputBox 
("Please enter Date Cells Example D2,D1:") rem 
----------------------------------------------------------------------dim args1(0) as new 
com.sun.star.beans.PropertyValueargs1(0).Name = "StringName"args1(0).Value = "=IF(DATEDIF(" & sText 
& ",""y""),IF(DATEDIF(" & sText & ",""y"")=1,""1 Year "",DATEDIF(" & sText & " ,""y"")&"" Years 
""),"""")&IF(MOD(DATEDIF(" & sText & ",""m""),12),IF(MOD(DATEDIF(" & sText & ",""m""),12)=1,""1 
Month "",MOD(DATEDIF(" & sText & ",""m""),12)&"" Months ""),"""")&IF(DATEDIF(" & sText & 
",""md""),IF(DATEDIF(" & sText & ",""md"")=1,""1 Day "",DATEDIF(" & sText & " ,""md"")&"" 
Days""),"""")"  dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args1()) end sub    
 On 4 Jul 2020 at 20:54, Andrew Pitonyak wrote: From:                 "Andrew Pitonyak" 
<andrew@pitonyak.org>Date sent:          Sat, 04 Jul 2020 20:54:34 -0400Copies to:          
users@global.libreoffice.orgTo:                     Michael D. Setzer II 
<msetzerii@gmail.com>Subject:             Re: [libreoffice-users] Confused with Macro               
             results?? > > > Might I ask what you want the macro to do? Your macro confuses me a 
bit...> > That said, the actual API has a very harsh learning curve (in my opinion). If I rip apart 
what I see, > I would guess the following:> > The user enters some text, which represents a set of 
cells separated by a comma.> > Next, you do things with these cells based on a very complicated 
formula. I am not familiar with > the EnterString dispatch off hand, but I assume that it places 
whatever this string is into a cell.> > Next you call the dispatcher to Copy to the clipboard 
followed by Cutting to the clipboard. That > seems redundant.> > > Next you have InsertContents, 
again, a dispatch command with which I have no familiarity, but, > off hand it looks like it is 
probably doing something similar to "Paste", but I am just guessing.> > So, what do you really want 
to accomplish?> > > > On Saturday, July 04, 2020 18:30 EDT, "Michael D. Setzer II" 
<msetzerii@gmail.com> wrote:> >     Been doing a lot of googling, but finding lots of stuff, but 
nothing >     that works?>     Have done a lot of versions and this is the latest one.>     The 
record process does not allow for the use of the F2 key, so as >     is, it>     results in the 
original args1(0).Value being in the cell?>     After the macro ends, I've found that if I manually 
press F2 then a >     space and>     enter it puts the formula as I originally wanted? F2 and enter 
does >     nothing??>     I've also found that if I manually do F2 F9 Enter Enter, it will place >  
   just the>     final text result in cell.>     >     Seems there use to be a Keypress option, 
that would allow for >     simulating>     keys, but that has been deprecated?>     Also, found 
pages that talk about API stuff to modify cells, but the >     two I tried>     did nothing?>     > 
    Am I missing something??>     >     Note: In string I replaced the original "s with _ because 
it kept >     giving me >     messages about unbalanced ()?? That got rid of the errors, and >     
then just>     converted them back?>     >     Not and important macro, but was just hoping to find 
a way to >     make it work>     the way I originally planned. Just playing around with stuff. >    
>      Thanks. Perhaps I am overlooking something very simple..>     >     >     sub Z1>     rem 
---------------------------------------------------------------------->     rem define variables>   
  dim document as object>     dim dispatcher as object>     rem 
---------------------------------------------------------------------->     rem get access to the 
document>     document = ThisComponent.CurrentController.Frame>     dispatcher = >     
createUnoService("com.sun.star.frame.DispatchHelper")>     >     rem 
---------------------------------------------------------------------- >     dim sText>     sText = 
InputBox ("Please enter Date Cells Example D2,D1:")>     >     rem 
---------------------------------------------------------------------->     dim args1(0) as new 
com.sun.star.beans.PropertyValue>     args1(0).Name = "StringName" >     args1(0).Value =>     
"=SUBSTITUTE(SUBSTITUTE(""=IF(DATEDIF(A2,A1,_y_),IF(DA>     TEDIF(A2,>     A1,_y_)=1,_1 Year 
_,DATEDIF(A2,A1,_y_)&_ Years>     _),__)&IF(MOD(DATEDIF(A2,A1,_m_),12),IF(MOD(DATEDIF(A2,>     
A1,_m_),1>     2)=1,_1 Month _,MOD(DATEDIF(A2,A1,_m_),12)&_ Months>     
_),__)&IF(DATEDIF(A2,A1,_md_),IF(DATEDIF(A2,A1,_md_)=1,_>     1 Day>     _,DATEDIF(A2,A1,_md_)&_ 
Days_),__)"",""A2,A1""," & chr$(34) >     & sText &>     chr$(34) & "),""_"",CHAR(34))">     >     
dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, >     args1())>     >     rem 
---------------------------------------------------------------------->     
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())>     >     rem 
---------------------------------------------------------------------- >     REM Cut contents of 
cell to avoid the overwrite message>     dispatcher.executeDispatch(document, ".uno:Cut", "", 0, 
Array())>     >     rem ---------------------------------------------------------------------->     
dim args2(5) as new com.sun.star.beans.PropertyValue >     args2(0).Name = "Flags">     
args2(0).Value = "SVD">     args2(1).Name = "FormulaCommand">     args2(1).Value = 0>     
args2(2).Name = "SkipEmptyCells">     args2(2).Value = false>     args2(3).Name = "Transpose">     
args2(3).Value = false>     args2(4).Name = "AsLink">     args2(4).Value = false>     args2(5).Name 
= "MoveMode">     args2(5).Value = 4>     >     dispatcher.executeDispatch(document, 
".uno:InsertContents", "", >     0, args2())>     msgbox ("To complete process,"+chr$(13)+" Formula 
Press F2 >     then Space >     then Enter" + chr$(13)+"For Text Result Press F2 then F9 then >     
Enter then>     Enter")>     >     end sub>     >     
+------------------------------------------------------------+>     Michael D. Setzer II - Computer 
Science Instructor (Retired)>     mailto:mikes@guam.net >     mailto:msetzerii@gmail.com>     Guam 
- Where America's Day Begins>     G4L Disk Imaging Project maintainer>     
http://sourceforge.net/projects/g4l/>     
+------------------------------------------------------------+>     >     >     >     >     -->     
To unsubscribe e-mail to: >     users+unsubscribe@global.libreoffice.org>     Problems? >     
https://www.libreoffice.org/get-help/mailing-lists/how-to-unsubscrib>     e/>     Posting 
guidelines + more: >     https://wiki.documentfoundation.org/Netiquette>     List archive: 
https://listarchives.libreoffice.org/global/users/ >     Privacy Policy: 
https://www.documentfoundation.org/privacy>     > > > >     


 

-- 
To unsubscribe e-mail to: users+unsubscribe@global.libreoffice.org
Problems? https://www.libreoffice.org/get-help/mailing-lists/how-to-unsubscribe/
Posting guidelines + more: https://wiki.documentfoundation.org/Netiquette
List archive: https://listarchives.libreoffice.org/global/users/
Privacy Policy: https://www.documentfoundation.org/privacy