PDDL task help. Error message. Syntax error - planning

I have this task:
16 compartments containing 3 red and 3 black balls are given as shown in the figure below.
Rearrange the balls so that the three red balls next to each other are directly followed by the black balls!
Two adjacent balls can be picked up from their compartment at the same time and moved to two adjacent compartments while maintaining their order.
PFPFPF__________
I have deduced a possible solution, but I get an error message like this:
/tmp/solver_planning_domains_tmp_41C20mfKR69ZM/domain.pddl: syntax error in line 110, '(':
domain definition expected.
Here is my solution, but i know there is a better, so i accept any help! Thanks!
;;;
(define (problem ball)
(:domain ball)
(:objects vp vp vp vf vf vf)
(:init
(at vp pos1)
(at vf pos2)
(at vp pos3)
(at vf pos4)
(at vp pos5)
(at vf pos6)
(clear pos7)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
(:goal (and
(clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(clear pos7)
(clear pos8)
(at vp pos9)
(at vp pos10)
(at vp pos11)
(at vf pos12)
(at vf pos13)
(at vf pos14)
(clear pos15)
(clear pos16)
))
)
(define (domain ball)
(:requirements :strips)
(:predicates (pos1 ?v)
(pos2 ?v)
(pos3 ?v)
(pos4 ?v)
(pos5 ?v)
(pos6 ?v)
(pos7 ?v)
(pos8 ?v)
(pos9 ?v)
(pos10 ?v)
(pos11 ?v)
(pos12 ?v)
(pos13 ?v)
(pos14 ?v)
(pos15 ?v)
(pos16 ?v))
; _______ _______
; P F P F P F_ _ _ _ _ _ _ _ _ _ ---> P F P F _ _PF _ _ _ _ _ _ _ _
;
(:action move1
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(pos2 ?vP)
(pos3 ?vp)
(pos4 ?vf)
(pos5 ?vF)
(pos6 ?vf)
(clear pos7)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(pos1 ?vp)
(pos2 ?vp)
(pos3 ?vp)
(pos4 ?vf)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(not (pos5 ?vp))
(not (pos6 ?vf))
(clear pos9)
(clear pos10)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16))
)
; P F P F _ _PF _ _ _ _ _ _ _ _ - - -> P _ _ F _ _P F F P _ _ _ _ _ _
(:action move2
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(pos2 ?vP)
(pos3 ?vp)
(pos4 ?vf)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(clear pos9)
(clear pos10)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(pos1 ?vp)
(clear pos2)
(clear pos3)
(pos4 ?vf)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(pos10 ?vp)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos2 ?vf))
(not (pos3 ?vp))
(not (clear pos9))
(not (clear pos10))
)
; P _ _ F _ _ P F F P _ _ _ _ _ _ ---> P P F F _ _ _ _ F P _ _ _ _ _ _
(:action move3
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(clear pos2)
(clear pos3)
(pos4 ?vf)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(pos10 ?vp)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(pos1 ?vp)
(pos2 ?vp)
(pos3 ?vf)
(pos4 ?vf)
(clear pos5)
(clear pos6)
(clear pos7)
(clear pos8)
(pos9 ?vf)
(pos10 ?vp)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (clear pos2))
(not (clear pos3))
(not (pos7 ?vp))
(not (pos8 ?vf))
)
; P P F F _ _ _ _ F P _ _ _ _ _ _ ---> P P _ _ _ _ _ _ F P F F _ _ _ _
(:action move4
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(pos2 ?vP)
(pos3 ?vf)
(pos4 ?vf)
(clear pos5)
(pos6 ?vf)
(clear pos7)
(clear pos8)
(pos9 ?vf)
(pos10 ?vp)
(clear pos11)
(clear pos12)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(pos1 ?vp)
(pos2 ?vp)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(clear pos7)
(clear pos8)
(pos9 ?vf)
(pos10 ?vp)
(pos11 ?vf)
(pos12 ? vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos3 ?vf))
(not (pos4 ?vf))
(not (clear pos11))
(not (clear pos12))
)
; P P _ _ _ _ _ _ F P F F _ _ _ _ ---> P P _ _ _ _ P F F _ _ F _ _ _ _
(:action move5
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(pos2 ?vP)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(clear pos7)
(clear pos8)
(pos9 ?vf)
(pos10 ?vp)
(pos11 ?vf)
(pos12 ?vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(pos1 ?vp)
(pos2 ?vp)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(clear pos10)
(clear pos11)
(pos12 ? vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos10 ?vp))
(not (pos11 ?vf))
(not (clear pos7))
(not (clear pos8))
)
; P P _ _ _ _ P F F _ _ F _ _ _ _ ---> _ _ _ _ _ _ P F F P P F _ _ _ _
(:action move6
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (pos1 ?vp)
(pos2 ?vP)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(pos10 ?vp)
(pos11 ?vp)
(pos12 ? vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos1 ?vp))
(not (pos2 ?vp))
(not (clear pos10))
(not (clear pos11))
)
; _ _ _ _ _ _ P F F P P F _ _ _ _ ---> _ _ P P _ _ P F F _ _ F _ _ _ _
(:action move7
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(pos10 ?vp)
(pos11 ?vp)
(pos12 ?vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(clear pos10)
(clear pos11)
(pos12 ? vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos10 ?vp))
(not (pos11 ?vp))
(not (clear 3))
(not (clear 4))
)
; _ _ P P _ _ P F F _ _ F _ _ _ _ ---> _ _P P F F P _ _ _ _ F _ _ _ _
(:action move8
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vf)
(pos9 ?vf)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(pos5 ?vf)
(pos6 ?vf)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ? vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
(not (pos8 ?vf))
(not (pos9 ?vf))
(not (clear 5))
(not (clear 6))
)
; ---> _ _P P F F P _ _ _ _ F _ _ _ _ ---> _ _ P P _ _ P _ _ _ _ F F F _ _
(:action move9
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(pos5 ?vF)
(pos6 ?vf)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(clear pos13)
(clear pos14)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
(not (pos5 ?vf))
(not (pos6 ?vf))
(not (clear 13))
(not (clear 14))
)
; ---> _ _ P P _ _ P _ _ _ _ F F F _ _ ---> _ _ _ _ P P P _ _ _ _ F F F _ _
(:action move10
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(pos3 ?vp)
(pos4 ?vp)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(pos5 ?vp)
(pos6 ?vp)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
(not (pos3 ?vp))
(not (pos4 ?vp))
(not (clear 5))
(not (clear 6))
)
; _ _ _ _ P P P _ _ _ _ F F F _ _ ---> _ _ _ _ _ _ P P P _ _ F F F _ _
(:action move11
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(pos5 ?vp)
(pos6 ?vp)
(pos7 ?vp)
(clear pos8)
(clear pos9)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vp)
(pos9 ?vp)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
(not (pos5 ?vp))
(not (pos6 ?vp))
(not (clear 8))
(not (clear 9))
)
; _ _ _ _ _ _ P P P _ _ F F F _ _ ---> _ _ _ _ _ _ _ _ P P P F F F _ _
(:action move12
:parameters (?vp ?vp ?vp ?vf ?vf ?vf)
:precondition (and (clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(pos7 ?vp)
(pos8 ?vp)
(pos9 ?vp)
(clear pos10)
(clear pos11)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
)
:effect (and
(clear pos1)
(clear pos2)
(clear pos3)
(clear pos4)
(clear pos5)
(clear pos6)
(clear pos7)
(clear pos8)
(pos9 ?vp)
(pos10 ?vp)
(pos11 ?vp)
(pos12 ?vf)
(pos13 ?vf)
(pos14 ?vf)
(clear pos15)
(clear pos16)
(not (pos7 ?vp))
(not (pos8 ?vp))
(not (clear 10))
(not (clear 11))
)

You are missing parentheses to close the (domain ...) statement.

Related

AttributeError: 'TestCaseFunction' object has no attribute 'wasSuccessful' (UnitTest to Pytest)

I am converting my unittest test cases to pytest.
While running my py file, the script does its function fine (device reboot) but my test script shows the following failure:
================================================================================================ FAILURES =================================================================================================
_________________________________________________________________________________________ TestReboot.test_reboot __________________________________________________________________________________________
../../custom_xmlrunner/custom_unittest_runner.py:245: in run
self.write_result(result)
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
self = <device_reboot.TestReboot testMethod=test_reboot>, result = <TestCaseFunction test_reboot>
def write_result(self, result):
"""
Write the result of the test-case, like:
-----------------------
TESTCASE: my_test_case
RESULT: PASS
-----------------------
This too is implicitly called at the end of the test-case.
"""
self.write_log('-' * 60)
self.write_log('TESTCASE: {0}'.format(self._testMethodName))
> if result.wasSuccessful():
E AttributeError: 'TestCaseFunction' object has no attribute 'wasSuccessful'
../../custom_xmlrunner/custom_unittest_runner.py:292: AttributeError

Getting an Invalid procedure call or Argument error in power query Excel VBA

I am trying to pull the data through power query but I am getting a "invalid procedure call or Argument" error
I have tried other options using arrays and lin input but as they were taking too much time, I have to shift to another option.
Error is in line: ActiveWorkbook.Queries.Add Name:=QueryName, Formula:=SourceFormula)
Below is the code:
Sub Import_AACR()
Dim QueryName, SourceFormula, ConnStr As String
QueryName = "AACR_Pull"
SourceFormula = "let Source = Csv.Document(File.Contents(""C:\ENDO AACR\AACR_20200123_2020Q1_V6.0.txt""),[Delimiter=""|"", Columns=27, Encoding=1252, QuoteStyle=QuoteStyle.None])," & _
"#""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & _
"#""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""REQUEST#"", Int64.Type}, {""REQUEST_SUBMIT_DT"", type text}, {""REQUEST_SUBMIT_TYPE"", type text}, {""SALES_TEAM"", type text}, {""DM_NAME"", type text}, {""STATUS"", type text}})in #""Changed Type"""
ActiveWorkbook.Queries.Add Name:=QueryName, Formula:=SourceFormula
Connstr = "OLEDB;" & _
"Provider = Microsoft.Mashup.OleDb.1;" & _
"Data Source = $Workbook$;" & _
"Location=""AACR_Pull"";" & _
"Extended Properties="""""
With ActiveSheets.ListObjects.Add(SourceType = xlSrExternal, _
LinkSource:=True, _
xlListObjectHasHeaders:=xlYes, _
Source:=Connstr, _
TableStyleName:="TableStyleMedium8", _
Destinatio:=Range("A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [AACR_Pull]")
.Refresh BackgroundQuery = False
End With
End Sub
The Source Formula query is copy-pasted from the power query editor and I have just used additional escape characters.
After looking into it for a day, I have found another workaround for importing the same text file with delimiters.
Instead of doing it through power query which loads a table, I have recorded a macro and have made some tweaks
Below is the updated code:
Sub Load_File()
Dim Old_File_Name As String
Dim New_File_Name As String
Old_File_Name = Worksheets("SUMMARY").Range("I3").Value
New_File_Name = Worksheets("SUMMARY").Range("I4").Value
File_Path_Old = "C:\ENDO AACR" & "\" & Old_File_Name
File_Path_New = "C:\ENDO AACR" & "\" & New_File_Name
Application.ScreenUpdating = False
Worksheets("OLD").Range("A1:AA1500").ClearContents
ChDir "C:\Filepath"
Workbooks.OpenText Filename:=File_Path_Old, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
27, 1)), TrailingMinusNumbers:=True
Range("A1:AA1500").Select
Selection.Copy
Windows("AACR_Automated.xlsm").Activate
ThisWorkbook.Worksheets("OLD").Select
Worksheets("OLD").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(Old_File_Name).Activate
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub ()

How to select currency from drop down and it changes all currency cells across workbook quickly

I am creating a private excel program that has multiple different currency format cells across the workbook.
I want to change all currency cells in the workbook from one currency to a selected currency.
This process must happen quickly and efficiently.
Any ideas?
I have been looking at multiple threads and no luck. I do not seam to find any threads that can quickly change the currency symbol of every currency cell.
Here are links to some sites I have tried:
- https://www.pcreview.co.uk/threads/vba-code-to-change-currency-format.3861711/
- https://social.msdn.microsoft.com/Forums/office/en-US/5828423e-96dd-4cae-8404-7d5d8adb328c/finding-all-currency-formatted-cells-and-change-the-currency-symbol?forum=exceldev
- https://www.reddit.com/r/excel/comments/4dcha1/i_need_a_way_to_change_all_currency_cells_across/
- https://www.ozgrid.com/forum/forum/help-forums/excel-general/67104-change-currency-symbol-from-list?t=77206
-https://chandoo.org/forum/threads/how-to-change-the-currency-symbol-dynamically-in-excel.7673/
-https://contexturesblog.com/archives/2010/06/23/conditional-formatting-for-currency-symbol/
I have not included all threads I looked at previously.
I just require something quick and efficient.
CODE:
Dim cur As Range
Set cur = Range("e12")
If Not Application.Intersect(cur, Range(Target.Address)) _
Is Nothing Then
If cur = "Dollar" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Euro" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Pound" Then
'dollar to dirham
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Dirham" Then
'dollar to dirham
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Rand" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
'
'
'
'
End If
End If
Solution if simple:
Make if statements the option in drop down.
Make this code run anytime a new selection is chosen and run all replace functions as none will evaluate a error. Easy bypass but effective nonetheless.
Code:
Range("o14").NumberFormat = "-[$$-en-US]* #,##0.00 ;-[$$-en-US]* -#,##0.00 ;-[$$-en-US]* ""-""??_ ;-# "
Range("o18").NumberFormat = "($* #,##0.00);($* (#,##0.00);($* ""-""??);(#)"
Range("o16").NumberFormat = "-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* ""-""??-;-#-"
Range("o15").NumberFormat = "-* #,##0.00 [$€-de-DE]-;-* #,##0.00 [$€-de-DE]-;-* ""-""?? [$€-de-DE]-;-#-"
Range("o17").NumberFormat = "-[$" & "AED" & "-en-US]* # ##0.00_) ;[Color46]-([$" & "AED" & "-en-US]* -# ##0.00) ;-[$" & "AED" & "-en-US]* ""-""??_ ;(#)"

Can I Simplify this Macro to Check if Cell is Empty and then Save Corresponding Sheets?

I'm trying to create an Excel VBA macro to look down a list one cell at a time to check if it's empty and then save a corresponding number of sheets equal to 3x the number of non-empty cells.
Here's the code for what I'm doing. I thought about using a loop within a loop, but I wasn't sure how to implement it or if it would work, so I used this, which does work.
Sub SaveMacro()
Dim Cell As Variant
Dim bFileSaveAs As Boolean
'For j = 0 To 12
Set Cell = Range("B3")
If Not IsEmpty(Cell) Then
Sheets(Array("L12", "L13-24", "L25-36")).Select
If Not IsEmpty(Cell.Offset(1, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36", "L12 (2)", "L13-24 (2)", "L25-36 (2)")).Select
If Not IsEmpty(Cell.Offset(2, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)")).Select
If Not IsEmpty(Cell.Offset(3, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)")).Select
If Not IsEmpty(Cell.Offset(4, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
, "L12 (5)", "L13-24 (5)", "L25-36 (5)")).Select
If Not IsEmpty(Cell.Offset(5, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
, "L12 (5)", "L13-24 (5)", "L25-36 (5)" _
, "L12 (6)", "L13-24 (6)", "L25-36 (6)")).Select
End If
End If
End If
End If
Sheets("L12").Activate
bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
End Sub
See if this does what you expect:
Sub SaveMacro()
Dim Cell As Range: Set Cell = Range("B3")
Dim sFileSaveAs As String
Dim R As Long, Z As Long, X As Long
Dim strSheets As String: strSheets = "L12,L13-24,L25-36"
Dim arrSheets(1 To 6) As Variant
Dim arrSheet() As String: arrSheet = Split(strSheets, ",")
For R = LBound(arrSheets) To UBound(arrSheets)
If R = 1 Then
arrSheets(R) = arrSheet
Else
arrSheets(R) = strSheets
For Z = 2 To R
For X = LBound(arrSheet) To UBound(arrSheet)
arrSheets(R) = arrSheets(R) & "," & arrSheet(X) & " (" & Z & ")"
Next X
Next Z
arrSheets(R) = Split(arrSheets(R), ",")
End If
Next R
For R = Cell.Row + 5 To Cell.Row Step -1
If Not IsEmpty(Cells(R, "B")) Then
Sheets(arrSheets(R - 2)).Copy
Exit For
End If
Next R
sFileSaveAs = ThisWorkbook.Path & "\range of sheets.xlsm"
ActiveWorkbook.SaveAs sFileSaveAs
End Sub
You can integrate this little selector in your macro by calling it, e.g. SelectSheets 3:
Sub SelectSheets(lCount As Long)
Dim lLoop As Long
If lLoop >= 1 Then Sheets(Array("L12", "L13-24", "L25-36")).Select
For lLoop = 2 To lCount
Sheets("L12 (" & lLoop & ")").Select False
Sheets("L13-24 (" & lLoop & ")").Select False
Sheets("L25-36 (" & lLoop & ")").Select False
Next
End Sub

Using GetMem and VarPtr to get around Object default values [duplicate]

This question already has answers here:
How can I assign a Variant to a Variant in VBA?
(5 answers)
Closed 3 years ago.
So I'm making a funky VBA class for callback objects. Currently one of the issues is that when returning data from the function's call method I have to run the method twice, one to determine the variable type and another to return the variable:
If VarType(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))) = vbObject Then
Set CallCallback = Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
Else
CallCallback = Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
End If
Recently I figured that I might be able to do this without calling the VBA function multiple times by dereferencing the result using VarPtr and then using GetMem4:
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Any) As Long
...
Dim vp As LongPtr, vRet as Variant
vp = VarPtr(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29)))
Call GetMem4(vp, vRet)
This specific example didn't work but I was wondering whether there was an obvious reason as to why this didn't work?
Any ideas?
I asked the question to vbforums also and they got there much faster than stackoverflow!
The solution is extremely simple:
Public Declare Sub VariantCopy Lib "oleaut32.dll" (ByRef pvargDest As Variant, ByRef pvargSrc As Variant)
...
VariantCopy CallCallback, Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
Simple!

Resources