Lister les fonts

Salut Zeb

merci pour ton message !

voici donc l'insert :

Sub Sheet1

Sub A1AllFonts()

Dim i, j, fn$, t$, FontList As CommandBarControl

Rem

Individuelt tegnformat, ActiveCell

On Error Resume Next

With ActiveCell

t = .Text: .ClearContents: fn = .Font.Name: .Formula = t

For j = 1 To .Characters.Count

With .Characters(j)

If AscW(.Text) > 256 Then

.Font.Size = 10

.Font.Name = "Arial Unicode MS" '"Arial Unicode MS","Cambria Math","Lucida Sans Unicode"

Else

.Font.Size = 10

.Font.Name = fn

End If: End With: Next: End With

Exit Sub

Rem

Application.ScreenUpdating = False

Set FontList = Application.CommandBars("Formatting" ).FindControl( ID:=172

t = [a1].Value: [b:c].Clear

For i = 1 To FontList.ListCount

Cells(i, 2).Font.Name = FontList.List(i)

Cells(i, 2).Formula = t

Cells(i, 3).Formula = FontList.List(i)

Next

Application.ScreenUpdating = True

End Sub

Rem

End Sub

Merci par avance... je coince grave !

Y'a-t-il quelqu'un qui m'aide ici ce soir ?

(Pas moi, je n'aurais pas accès à OOo avant ce we. C'est si pressé ?)

Hello Zeb !

Content de te croiser...

On est que tous les deux ici ?

Il fait froid et c'est tout noir.... lol

C'est pas urgent urgent mais je suis planté... tu veux bien me tuyauter ?

A plus Zeb

Pas avant ce we. Et pas du tout si la neige me bloque.  
En constatant par ailleurs que je suis un Linuxien éclairé, tu serais en droit de croire que les logiciels bureautiques libres n'ont aucun secret pour moi. Et bien non. En matière de tableur, je reste fidèle à la plus belle réussite de MS : Excel.
(J'ai bien un OOo d'installé sur mon portable sous Ubuntu, mais je ne l'ai pas sous la main)

M'enfin...
EH Y'A QUELQU'UN QUI PEUT AIDER TITOU ??????

Bon... Je jetterai un œil ce soir... Mais je promet rien...  

C'est bien pour pas vous laisser tout seuls dans le noir et le froid...  

  Zeb,
  Storos,

Bon, la neige est venue, j'espère que Zeb n'est pas resté bloqué ! Ici on a un peu plus de 5cm sur le verglas...

Je suis heureux de voir que nous sommes trois,   maintenant. he he he

j'ai essayé plusieurs modifs mais c'est plus simple en VBA et je suis d'accord avec Zeb : EXCEL est bien le meilleur !

je compte donc sur vous mes amis... un coup de main s'il vous plait.



Cordialement,

T2

  Hello


Cher Papa Noël,

Fait qu'il y ait plus de gens actifs dans ce forum pour m'aider à avancer dans l'écriture en Basic de ma macro...



A moins qu'un génie passe par ici....

A plus Zeb, Storos  

Ça c'est du up, ou je ne m'y connais plus ^^

Regarde ce premier exemple :

sub liste_des_fonts

	Dim font As Object

	Dim list As String

	Dim i As Integer

 
	i = 1

	for each font in CreateUnoService("com.sun.star.awt.Toolkit").createScreenCompatibleDevice(0, 0).FontDescriptors

		list = list & font.Name

		if font.StyleName <> "" then list = list & " (" & font.StyleName & ")"

		list = list & chr(10)

		if i Mod 20 = 0 then

			Msgbox list

			list = ""

		end if	

		i = i + 1

	next

	Msgbox list

end sub

Hello Zeb,  

Merci pour le temps que tu as pris pour essayer de trouver une solution !  

La macro, que tu as la gentillesse de me proposer, liste bien toutes les polices... Euh... Je me suis sans doute mal exprimé, mon objectif est d'afficher le contenu de A1 dans la colone B, décliné dans toutes les fonts du système...

J'ai fais d'autres recherches de mon côté. En voici un exemple, qui ne marche pas NON PLUS ! grrr

Sub ExemplePolice()

 
 
phrase=InputBox("phrase de test :","Liste des polices","Ceci est un essai") 

 
oText=thisComponent.getText() 

oCursor = oText.createTextCursor() 

 
rem 'Liste des fontes '

 
Dim oToolkit as Object 

oToolkit = CreateUnoService("com.sun.star.awt.Toolkit") 

Dim oDevice as Variant 

oDevice = oToolkit.createScreenCompatibleDevice(0, 0) 

Dim oFontDescriptors As Variant 

oFontDescriptors = oDevice.FontDescriptors 

Dim oFontDescriptor As Object 

 
thiscomponent.lockcontrollers 

for i= LBound(oFontDescriptors) to UBound(oFontDescriptors) 

oCursor.CharFontName=oFontDescriptors(i).Name 

oCursor.string=cstr(i)+". "+oFontDescriptors(i).Name+chr(10) 

valide=oCursor.gotoEnd(false) 

oCursor.string=phrase+chr(10)+chr(10) 

valide=oCursor.gotoEnd(false) 

next i 

thiscomponent.unlockcontrollers 

 
End Sub

Ahhh, je regrette le Cobol et le Pascal tiens ! ça c'était une époque glorieuse !

Petit Papa Noël, ... n'oublie pas mon ami Zeb...

A plus,

Titou

Ah non, cher ami, ne compte pas sur moi pour faire ta macro.

Par contre, je te liste les polices dans un premier temps, je te copie du texte d'une case à l'autre dans un second temps, puis j'applique une police sur un texte dans un troisième temps. Ensuite, avec tes petits doigts, tu me compiles tout ça pour faire TA macro. Tu la publies ici et je te dis comment tu aurais pu faire mieux. A l'issue, on aura appris beaucoup de choses et on aura une macro qui fait ce qu'on lui demande et qui aura le bon goût de le faire bien.

(La suite ce soir   )

  Zeb,


Top-là...

Je te propose de me signaler aussi les boulettes qui sont dans mes premiers listings...

Cordialement,

Titou