Lista hiperłączy do arkuszy (konwersja makra VBA > OOBasic)

Makropolecenia i funkcje w języku Basic
wuj_stach
Posty: 4
Rejestracja: pt paź 29, 2010 4:18 pm

Lista hiperłączy do arkuszy (konwersja makra VBA > OOBasic)

Post autor: wuj_stach »

Witam,

To ja jeszcze raz z podobnym problemem, tym razem prośba o pomoc przy przeróbce takiego makra(tworzy spis Arkuszy wraz z hiperłączami do Arkuszy):

Kod: Zaznacz cały

Sub Zrób_Listę_Hiperłączy_do_Arkuszy()
  Const Spis = "Spis arkuszy"
  
  Dim sh As Worksheet
  Dim w As Integer
  
  'przejscie do arkusza ze spisem i ewentualne jego utworzenie
  On Error Resume Next
  Worksheets(Spis).Select
  If Err > 0 Then
        Worksheets.Add Before:=Sheets(1)
        ActiveSheet.Name = Spis
  End If
  On Error GoTo 0
  
  'wpisanie listy arkuszy
  Cells.Clear
  Worksheets(Spis).Cells(1, 1) = Spis
  w = 1
  For Each sh In Worksheets
        If sh.Name <> Spis Then
        w = w + 1
                With Worksheets(Spis)
                         .Hyperlinks.Add .Cells(w, 1), "", "'" & sh.Name & "'!A1", , sh.Name
                End With
        End If
  Next sh
End Sub
Z góry wielkie dzięki za pomoc.
Ostatnio zmieniony pt kwie 27, 2012 1:45 pm przez Jan_J, łącznie zmieniany 1 raz.
Powód: Dla nowego tematu zakładamy nowy wątek. W tytule opisujemy problem
OpenOffice 3.2 pod Ubuntu 10.04
Jan_J
Posty: 4579
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Lista hiperłączy do arkuszy (konwersja makra VBA > OOBas

Post autor: Jan_J »

Chyba o to ci chodzi:

Kod: Zaznacz cały

Sub robiHipertekstowySpisArkuszy()
	nazwaSpis = "Spis arkuszy"
	doc = thisComponent
	arks = doc.Sheets
	on error goto wstaw_spis
	ark = arks.getByName(nazwaSpis)
	goto wstaw_linki:
  wstaw_spis:
	arks.insertNewByName(nazwaSpis, 0)
	ark = arks.getByName(nazwaSpis)
  wstaw_linki:
	on error goto blad
	ark.getCellRangeByPosition(0,0,0,1000).clearContents(-1) 'czyści kolumnę A w spisie
	ark.getCellByPosition(0,0).setString(nazwaSpis)
	j = 0
	for i = 0 to arks.Count-1
	  a = arks.getByIndex(i)
	  aName = a.Name
	  if aName <> nazwaSpis then
	    j = j+1
	    wstawiaLinkDoKomorki(doc, ark.getCellByPosition(0,j), aName, "#" & aName)
	  end if
	next i
	goto koniec
  blad:
	print("Błąd podczas wstawiania łączy")
  koniec:
End Sub

Sub wstawiaLinkDoKomorki(dokument, komorka, tekst, adres)
	text = komorka.getText()
	lnk = dokument.createInstance("com.sun.star.text.TextField.URL")
	lnk.URL = adres
	lnk.Representation = tekst
	komorka.insertTextContent(text.createTextCursor(), lnk, True) 
End Sub
Prawie słowo w słowo. Patrz też http://www.oooforum.org/forum/viewtopic.phtml?t=63158 i standardowa literatura do OOo API: http://www.openoffice.org/api/, http://www.openoffice.org/api/basic/man ... torial.pdf, http://www.pitonyak.org/AndrewMacro.odt, http://www.pitonyak.org/OOME_3_0.pdf
JJ
LO (24.2|7.6) ∙ Python (3.12|3.11|3.10) ∙ Unicode 15 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
wuj_stach
Posty: 4
Rejestracja: pt paź 29, 2010 4:18 pm

Re: Lista hiperłączy do arkuszy (konwersja makra VBA > OOBas

Post autor: wuj_stach »

Dzięki właśnie o to mi chodziło. Wszystko działa jak należy.
OpenOffice 3.2 pod Ubuntu 10.04
ODPOWIEDZ