Proszę o podpowiedź w jaki sposób część tekstu w komórce szybko
przeformatować na indeks górny. Dotychczas robię to tak:
- zaznaczam fragment tekstu w komórce
- wciskam Ctrl+1 i "ptaszkuję" indeks górny
- przesuwam kursor poza tekst i kasuję zaznaczony haczyk.
Jest to operacja bardzo uciążliwa jeśli korzysta się często z indeksu
górnego. Word oferuje np przycisk "indeks górny" który można sobie wyciągnąć
na pasek narzędzi. W Excelu tego nie ma. Nie działa także rejestracja makra,
bowiem nie można go uruchomić w trybie edycji komórki. Odpada także malarz
formatów, bowiem działa on na całą komórkę a nie na fragmwent tekstu
Czy ktoś ma jakiś pomysł?
--
pozdrawiam
ML
http://excel.vip.interia.pl
Sub Indeks_górny()
Selection.Font.Superscript = True
End Sub
naciskam F8, zaznaczam w komórce fragment tekstu do indeksu, i ponownie F8 (lub
F5), po czym zaznaczam drugą komórkę i wtedy już tylko raz F8, przechodzę do
następnej i.t.d., i.t.d.
Na koniec by wyjść z edytora trzeba zaznaczyć dowolną komórkę.
Sprawdzałem na Excelu 2000
Pozdrawiam
Henryk Tomczyk
P.S.
http://excel.vip.interia.pl - b.fajna stronka!
Odpisując usuń WYTNIJ z adresu
Pozdrawiam
Henryk Tomczyk
Wszystko zalezy jak chcesz zalozyc indeks
x- od ktorego znaku zalozyc gorny indeks
y-ile znakow zastosowac jako gorny index
Characters(x, y)
tak wiec jezeli chcesz rozne ustawiac indeks mosisz
pobrac te dwie wartosci
mozna przez inputbox
jezeli zas chcesz zalozyc staly np "m2" 2 jako gorny to taki kod
zalatwi sprawe
Sub Indeks()
If ActiveCell.Characters(Len(ActiveCell.Text), 1) _
.Font.Superscript = True Then
ActiveCell.Characters(Len(ActiveCell.Text), 1) _
.Font.Superscript = False
Else
ActiveCell.Characters(Len(ActiveCell.Text), 1) _
.Font.Superscript = True
End If
End Sub
oczywiscie dotyczy aktywnej komorki
Janusz
Ja wymyśliłem coś takiego jak poniżej.
Pomysł opiera się na wpisaniu jakiegoś znaku (przykład ze znakiem
"|")zamiast klikania na menu i wybierania menu Format -> Czcionka itd.
Czyli na przykład, żeby wpisać metry kwadratowe należy wpisaćw komórkę:
m|2|
a obok zaraz pojawi się menu z dwoma przyciskami "Stwórz Indeks górny" i
"Anuluj"
Najlepiej byłoby wykorzystać do tego tagi inteligentne, ale do tego potrzeba
by było programu który skompiluje kod do biblioteki DLL (np. Visual Basic
6.0), ponieważ w samym XML-u mozna jedynie tworzyć tagi integentne z
adresami URL.
Poniżej przykład dodatku Excela
'---------------------------------
' Kod w module ThisWorkbook:
Option Explicit
Private Sub Workbook_Open()
On Error Resume Next
Set a.app = Application
End Sub
'---------------------------------
' Kod w module klasy Class1:
Option Explicit
Public WithEvents app As Application
Public WithEvents sheet As Worksheet
Public komórka As Range
Private czyKasowaćMenu As Boolean
Private Sub app_SheetActivate(ByVal Sh As Object)
'MsgBox "Activate"
Set Me.sheet = Sh
End Sub
Private Sub app_WorkbookActivate(ByVal Wb As Workbook)
Set Me.sheet = Wb.ActiveSheet
End Sub
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
Set Me.sheet = Wb.ActiveSheet
End Sub
Private Sub sheet_Change(ByVal Target As Range)
'sprawdzamy ile znaków "|" zawiera komórka która się zmieniła
If UBound(Split(Target.Text, "|")) > 1 Then
Set komórka = Target
czyKasowaćMenu = True
CreateMenu Target.Offset(0, 1).Left, Target.Offset(1, 0).Top
End If
End Sub
Private Sub sheet_SelectionChange(ByVal Target As Range)
If czyKasowaćMenu = True Then KasujPasek
End Sub
'---------------------------------
' Kod w module standartowym
Option Explicit
Public a As New Class1
Sub CreateMenu(Left As Long, Top As Long)
Dim MyMenu As CommandBar
Dim cbSuperscipt As CommandBarButton
Dim cbAnuluj As CommandBarButton
Set MyMenu = CommandBars.Add(Name:="Indeksy", _
MenuBar:=False, Temporary:=True, Position:=msoBarPopup)
'deklarowanie przycisków
Set cbSuperscipt = MyMenu.Controls.Add(Type:=msoControlButton)
cbSuperscipt.Style = msoButtonCaption
cbSuperscipt.Caption = "Stwórz Indeks górny"
cbSuperscipt.OnAction = "CreateSuperscript"
Set cbAnuluj = MyMenu.Controls.Add(Type:=msoControlButton)
cbAnuluj.Style = msoButtonCaption
cbAnuluj.Caption = "Anuluj"
cbAnuluj.OnAction = "KasujPasek"
MyMenu.ShowPopup
'menu pojawia się w miejscu gdzie aktualnie znajduje się wskaźnik myszy
'ale właściwie to chciałem, aby w tym miejscu wykorzystać argumenty Left i
Top
'więc śledźcie proszę wątek "[VBA] Show Popup a punkty" na grupie
ms-news.pl.office
End Sub
Sub KasujPasek()
On Error Resume Next
Application.CommandBars("Indeksy").Delete
End Sub
Sub CreateSuperscript()
Dim tekst() As String
Dim i As Long
Dim początek As Long
Dim dł As Long
tekst = Split(a.komórka.Text, "|")
a.komórka.Value = Replace(a.komórka.Text, "|", "")
początek = 1
For i = LBound(tekst) To UBound(tekst) - 1 Step 2
początek = początek + Len(tekst(i))
dł = Len(tekst(i + 1))
a.komórka.Characters(początek, dł).Font.Superscript = True
początek = początek + dł
Next
End Sub
Sub PrzypiszObiekty()
'On Error Resume Next
Set a.app = Application
Set a.sheet = ActiveWorkbook.ActiveSheet
End Sub
'---------------------------------
--
Pozdrowienia
px...@poczta.onet.pl
Wielkie dzięki!!!!
Jesteś prawdziwym debeściakiem
Jeszcze poprawka:
W procedurze sheet_Change na samym początku trzeba dodać zabezpieczenie
przed zmianą jednocześnie kilku komórek
If Target.Count <> 1 Then Exit Sub
Jest jeszcze problem polegający na tym, że zaraz po zainstalowaniu dodatku
nie będzie ono działało dopóki nie uaktywni się jakiegoś skoroszytu czy
arkusza i nie wiem jak go rozwiązać. Wynika to z tego, że wszelkie
ActiveCośtam w procedurze zdarzenia Open dodatku dotyczą dodatku, i dlatego
nie można uzyć takiego zapisu:
Set a.sheet = ActiveSheet
Co ciekawe nie następuje potem żadne zdarzenie Activate ani Deactivate i
dlatego nie ma nawet jak wykorzystać zdarzeń obiektu Application.
Może ktoś zna rozwiązanie.
--
Pozdrowienia
px...@poczta.onet.pl
(.......)
> Jest jeszcze problem polegający na tym, że zaraz po zainstalowaniu dodatku
> nie będzie ono działało dopóki nie uaktywni się jakiegoś skoroszytu czy
> arkusza i nie wiem jak go rozwiązać. Wynika to z tego, że wszelkie
> ActiveCośtam w procedurze zdarzenia Open dodatku dotyczą dodatku, i
dlatego
> nie można uzyć takiego zapisu:
>
> Set a.sheet = ActiveSheet
>
> Co ciekawe nie następuje potem żadne zdarzenie Activate ani Deactivate i
> dlatego nie ma nawet jak wykorzystać zdarzeń obiektu Application.
> Może ktoś zna rozwiązanie.
>
Wynika to z tego, ze "przekombinowales" , wystarczy w kodzie klasy uzyc
zdarzenia Application SheetChange i wszystko znacznie sie uprosci. Oto moja
wersja twojego dodatku pozbawiona powyzszej niedogodnosci (i uproszczona
jeszcze w kilku innych miejscach) : -)
'---------------------------------
' Kod w module ThisWorkbook:
Option Explicit
Private Sub Workbook_Open()
Set a.app = Application
On Error GoTo koniec
With Application.CommandBars.Add(Name:="Indeksy", _
MenuBar:=False, Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton)
.Style = msoButtonCaption
.Caption = "Stwórz Indeks górny"
.OnAction = "CreateSuperscript"
End With
With .Controls.Add(Type:=msoControlButton)
.Style = msoButtonCaption
.Caption = "Anuluj"
End With
End With
koniec:
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set a.app = Nothing
On Error Resume Next
Application.CommandBars("Indeksy").Delete
End Sub
'---------------------------------
' Kod w module klasy AppClass:
Option Explicit
Public WithEvents app As Application
Public komórka As Range
Private Sub app_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If UBound(Split(Target.text, "|")) > 1 Then
Set komórka = Target
Application.CommandBars("Indeksy").ShowPopup
End If
End Sub
'----------------------------
' Kod w module standartowym
Option Explicit
Public a As New AppClass
Sub CreateSuperscript()
Dim tekst As Variant
Dim i As Long
Dim początek As Long
Dim dł As Long
tekst = Split(a.komórka.text, "|")
a.komórka.Value = Replace(a.komórka.text, "|", "")
początek = 1
For i = LBound(tekst) To UBound(tekst) - 1 Step 2
początek = początek + Len(tekst(i))
dł = Len(tekst(i + 1))
a.komórka.Characters(początek, dł).Font.Superscript = True
początek = początek + dł
Next
End Sub
'---------------------------------
To wszystko.
Dla zaineresownych programem uzytkownikow Excela 97 (do ktorych takze
naleze), podaje ponizej "zastepniki" funkcji Replace i Split, ktorych nie ma
w tej wersji. (Nalezy je umiescic w module standardowym)
'---------------------------------
Public Function Split(sStr As String, sDelim As String) As Variant
Split = Evaluate("{""" & _
Application.Substitute(sStr, sDelim, """,""") & """}")
End Function
Public Function Replace(sStr As String, sChars As String, sToChars As
String) As Variant
Replace = Application.Substitute(sStr, sChars, sToChars)
End Function
Pozdrawiam
Tajan
> Wynika to z tego, ze "przekombinowales" , wystarczy w kodzie klasy uzyc
> zdarzenia Application SheetChange i wszystko znacznie sie uprosci. Oto
moja
> wersja twojego dodatku pozbawiona powyzszej niedogodnosci (i uproszczona
> jeszcze w kilku innych miejscach) : -)
(...)
No proszę jak ładnie :-)
Rzeczywiście trochę przekombinowałem, nie pomyślałem o tym zdarzeniu, byc
może dlatego że rzadko wspólpracuje się ze zdarzeniami aplikacji.
--
Pozdrowienia
px...@poczta.onet.pl
> Pozdrawiam
> Tajan
>
>
Dzięki! Dodatek niby działa wspaniale, ale nie udało mi się wpisać m2
(czytaj: m kwadrat). M do innej potęgi - owszem, ale mkwadrat - nie :-)
Cóż, pewnie czeka mnie kolejna reinstalacja Excela...
Swoją drogą aż się prosi aby ten pomysł zastosować przy implementacji
autokorekty (znanej z Worda) do części tekstu w komórce Excela. Utworzyć
tylko
interfejs pozwalający na dopisywanie nowych pozycji i gotowe.
Jak się z tym uporam to się pochwalę :-)
Jeszcze raz dziekuję.