[Solved]Uruchamianie kilku makr

[szybkibill123]

Mam problem
Mam kilka makr które muszę wywołać. Nie ma dla mnie znaczenia czy na raz czy po kolei, ale nie mogę znaleźć sposobu żeby zrobić to w jednym czasie. Jedyną opcją jest przypisanie do każdego makra osobnego guzika i wciskanie ich po kolei. Czy istnieje sposób na odpalenie tych makr na raz ?

[belstar]

Instrukcja Call - sprawdź w pomocy

Kod: Zaznacz cały

Sub Pierwsze()
print "pierwsze makro"
drugie()
end sub

sub drugie()
print "drugie makro"
trzecie()
end Sub

sub trzecie()
print "trzecie makro"
end sub

[szybkibill123]

niestety nie wiem czemu, ale nie działa. Jak mają być umieszczone makra ? W modułach arkusza na którym pracuję, czy w moich makrach ? Dodam że są to dwa makra kopiujące z jednego arkusza do dwóch różnych>

[belstar]

Tak naprawdę nie powinno to mieć znaczenia gdzie trzymasz te makra, jeśli w dokumencie powinno zawsze działać , jeśli w jakiejś innej bibliotece to powinna być ona przed uruchomieniem makra załadowana, ale wtedy dostaniesz odpowiedni komunikat.

Kod: Zaznacz cały

Sub Load_Biblioteke
 BasicLibraries.LoadLibrary("Twoja Biblioteka")
End Sub

Dodam że są to dwa makra kopiujące z jednego arkusza do dwóch różnych>

Sprecyzuj.
Czy to są dwa różne arkusze tego samego dokumentu?

Niekiedy między wywołaniami makr trzeba wprowadzić celowe opóźnienie.
Np. makro drukuje oryginał faktury i kopie, pomiędzy wywołaniami drukowania zmienia zawartość komórki (oryginał/kopia) i w tym wypadku bez opóźnienia wydrukuje tylko oryginał (przynajmniej tak jest u mnie).

Spróbuj zastosować instrukcję Wait

Kod: Zaznacz cały

wait 2000 ' dwie sekundy

[szybkibill123]

Trochę bardziej się rozpiszę i otworzę ponownie wątek bo jednak mam problemy. To jest tak. Mam jeden dokument w którym są cztery arkusze. Jeden arkusz jest tym z którego kopiowane są dane, ale po kopiowaniu nic się w nim nie zmienia. Chodzi o to że chcę te dane skopiować do dwóch różnych arkuszy ale w tym samym dokumencie. Sęk w tym że są to różne zakresy danych więc użyłem dwóch makr. Teraz nie wiem jak je wywołać jednocześnie, bo każde uruchamiane z osobna działa. Dodam jeszcze że problem nie polega na wywalaniu jakiegokolwiek błędu. Po prostu makro jakby się uruchamiało, ale nie uruchamiało tych dwóch pod-makr. Nie wiem czy to ja coś źle wpisuję albo popełniam inny błąd, ale nie działa.

[kerim]

Witam

Prawdopodobnie po wykonaniu jednego makra nie wykonujesz powrotu do Arkusza z ktorego chcesz kopiowac i drugie makro wykonuje sie ale w niewlasciwym Arkuszu.
Nalezy wrocic do wlasciwego Arkusza np:
ThisComponent.CurrentController.Select(ThisComponent.Sheets.getByName("Arkusz2").getCellRangeByName("A1"))
lub
ThisComponent.CurrentController.setActiveSheet(ThisComponent.Sheets.getByName("Arkusz2"))

Pozdrawiam
Kerim

[szybkibill123]

niestety to nie to ponieważ żadne makro się nie wykonuje niezależnie od tego w jakiej kolejności ma być wykonane

[Jan_J]

Spróbuj debuggerem. Narzędzia/makro/edycja, stań na podprogramie których chcesz uruchomić i wciskaj F8. Będziesz przesuwać się o jedną instrukcję. W międzyczasie sprawdzaj, co się dzieje z Twoimi zmiennymi. Posiadanie rozszerzenia X-Ray albo MRI ułatwi podgląd.

Albo podeślij kod z nieuruchamiającymi się makrami, wypranymi z poufnej zawartości. Bo zgadywać nikomu się nie chce.

[szybkibill123]

Kod: Zaznacz cały

sub Kopiuj
	Dim Gdzie As String
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName("")
	oSourceRange = oSheet.getCellRangeByName("A1;B1")
	oDataArray = oSourceRange.getDataArray
   
	oDestSheet = oDoc.Sheets.getByName("")
	Gdzie = trim(str(getCountA(oDestSheet) + 14))
	Gdzie = "A" & Gdzie & ":B" & Gdzie
	oDestRange = oDestSheet.getCellRangeByName(Gdzie)
	oDestRange.setDataArray(oDataArray)
   'nadanie kolejnego numeru
	oSheet.getCellRangeByName("B5").setValue(oSheet.getCellRangeByName("B5").getValue + 1)
	'Usuwanie zawartości
	With com.sun.star.sheet.CellFlags
		flagi = .STRING + .VALUE '+ .DATETIME + .FORMULA
	End With



end sub

Function getCountA(arkusz)
	oFunct = createUnoService( "com.sun.star.sheet.FunctionAccess" )
	oRange = arkusz.getCellRangeByName("C1:C10")
	getCountA = oFunct.callFunction("COUNTA" , ARRAY(oRange)) 
End Function

to jest kod makra, mam takie dwa i nie wiem jak zrobić żeby uruchamiały się po sobie kopiując do różnych arkuszy podobne zakresy

[belstar]

Wybacz u mnie związanie dwóch makr działa.

Czy celowo usunąłeś nazwy arkuszy?
W tej lini (jaki zakres) - powinien być użyty dwukropek nie średnik.

Kod: Zaznacz cały

 oSourceRange = oSheet.getCellRangeByName("A1;B1")

Wstawiam swoje działające związanie (uruchamiane z kopiuj_1)

Kod: Zaznacz cały

sub Kopiuj_1
       Dim Gdzie As String
       oDoc = ThisComponent
       oSheet = oDoc.Sheets.getByName("Arkusz1")
       oSourceRange = oSheet.getCellRangeByName("A1:B1")
       oDataArray = oSourceRange.getDataArray
       
       oDestSheet = oDoc.Sheets.getByName("Arkusz2")
       Gdzie = trim(str(getCountA(oDestSheet) + 14))
       Gdzie = "A" & Gdzie & ":B" & Gdzie
       oDestRange = oDestSheet.getCellRangeByName(Gdzie)
       oDestRange.setDataArray(oDataArray)
       'nadanie kolejnego numeru
       oSheet.getCellRangeByName("B5").setValue(oSheet.getCellRangeByName("B5").getValue + 1)
       'Usuwanie zawartości
       With com.sun.star.sheet.CellFlags
          flagi = .STRING + .VALUE '+ .DATETIME + .FORMULA
       End With

	Kopiuj_2

    end sub

    Function getCountA(arkusz)
       oFunct = createUnoService( "com.sun.star.sheet.FunctionAccess" )
       oRange = arkusz.getCellRangeByName("A1:A100")
       getCountA = oFunct.callFunction("COUNTA" , ARRAY(oRange))
    End Function

 sub Kopiuj_2
       Dim Gdzie As String
       oDoc = ThisComponent
       oSheet = oDoc.Sheets.getByName("Arkusz1")
       oSourceRange = oSheet.getCellRangeByName("A1:B1")
       oDataArray = oSourceRange.getDataArray
       
       oDestSheet = oDoc.Sheets.getByName("Arkusz3")
       Gdzie = trim(str(getCountA(oDestSheet) + 14))
       Gdzie = "A" & Gdzie & ":B" & Gdzie
       oDestRange = oDestSheet.getCellRangeByName(Gdzie)
       oDestRange.setDataArray(oDataArray)
       'nadanie kolejnego numeru
       oSheet.getCellRangeByName("B5").setValue(oSheet.getCellRangeByName("B5").getValue + 1)
       'Usuwanie zawartości
       With com.sun.star.sheet.CellFlags
          flagi = .STRING + .VALUE '+ .DATETIME + .FORMULA
       End With
    end sub

[szybkibill123]

Dzięki bardzo, teraz działa, mam tylko jedno pytanie. Jak scalić dwa takie makra, jest to makro zapisujące.

Kod: Zaznacz cały

REM  *****  BASIC  *****
Option Explicit

' Katalog bazowy dokumentów
Const csBaseDocDir As String = "c:\Faktura"
Const csSheetName As String = "Faktura"
Const csNumberFormat As String = ""

Private sPathSep As String

' ========================================================
' SaveSheet
' ========================================================
Sub Zapisz_faktury
 Dim oDoc As Object
 Dim oSheet As Object
 Dim oCell As Object
 Dim dDate As Date
 Dim sDocNumber As String
 
 Dim sDateISO As String
 Dim sDirDay As String
 Dim sDirMonth As String
 Dim sDirYear As String
 Dim sDir As String

 sPathSep = GetPathSeparator()
 
 oDoc = ThisComponent
 oSheet = oDoc.Sheets.getByName(csSheetName)

 oCell = oSheet.getCellByPosition(0,0) ' B3 Data dok.
 dDate =  oCell.getValue()
 
 oCell = oSheet.getCellByPosition(0,1) ' F8 Numer dok.
 sDocNumber = oCell.getString() ' wartosc z formatowaniem
   
 sDateISO = CDateToISO(dDate)
 sDirDay = Right(sDateISO,2)
 sDirMonth = Mid(sDateISO, 5, 2)
 sDirYear = Left(sDateISO, 4)
 sDir = csBaseDocDir + sPathSep + sDirYear  +  _
                      sPathSep + sDirMonth +  _
                      sPathSep + sDirDay 
 SaveDocument sDir,  sDocNumber + ".ods"

End Sub

' ========================================================
' SaveDocument
' ========================================================
Sub SaveDocument( sDirName As String, sFileName As String )
  Dim args(0) As New com.sun.star.beans.PropertyValue
  Dim sURL As String
  
  MkDir(sDirName)
  
  sURL=ConvertToURL(sDirName + sPathSep + sFileName)
  ThisComponent.storeToURL(sURL, args())
End Sub