Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: [Excel] Dopasowanie komorki. Znowu czegos nie wiem....
Mroowek




Typ: neutral
Postów: 51
Zarejestrowany: Feb 2005
[Excel] Dopasowanie komorki. Znowu czegos nie wiem....

Witam.

Problem jest taki.
Mam jakiś tekst:

strTekst="Ala ma kota." & vblf & "Kot ma Alę." & vblf & "Tra-la-la"


Ten tekst wstawiam do komórki załóżmy A1:

    With ThisWorkbook.Worksheets("arkusz1" ) .Cells(1, 1)
        .Value = strTekst
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With


Ten kodzik dopasowuje mi komórkę do tekstu, ale...
w komórce chcę mieć TYLKO 3 wiersze! A excel w miejscu gdzie jest spacja przechodzi do nowego wiersza... i robi się bałagan...

Jeśli da się ustawić ilość wierszy w komorce Excela (przy pomocy VBA) to proszę o podpowiedź jak to zrobić. Jeśli nie da się to też proszę o wypowiedzi.
A może jest jakaś prostsza metoda??? inny sposób???
Z góry dziękuję.

Pozdrowionka.

[Post edytowany dnia 02-04-2005 02:45 przez Mroowek]

31-03-2005 04:12
Pokaż profil Mroowek  Wyślij email do Mroowek        4892300
Reawer



Typ: neutral
Postów: 25
Zarejestrowany: Oct 2002

Oto co dla Ciebie wykombinowałem:

strTekst = "Ala ma kota." & vbLf & "Kot ma Alę." & vbLf & "Tra-la-la"
With ThisWorkbook.Worksheets("arkusz1".Cells(1, 1)
        .Value = strTekst
        .WrapText = False 'zawijanie tekstu
        .EntireColumn.AutoFit
        .WrapText = True  'zawijanie teksu
        .EntireColumn.AutoFit
        End With
Problem leży w zawijaniu tekstu.
Powinno zadziałąć

Pozdro dla wszystkich VBA i VB maniaków
NARA

31-03-2005 11:06
Pokaż profil Reawer  Wyślij email do Reawer   
Mroowek




Typ: neutral
Postów: 51
Zarejestrowany: Feb 2005

Dzieki Reawer!!!

Dziala znakomicie!
Że też nie wpadł mi do łepetynki ten Wraptext...

Pozdrowionka.

31-03-2005 12:07
Pokaż profil Mroowek  Wyślij email do Mroowek        4892300
Mroowek




Typ: neutral
Postów: 51
Zarejestrowany: Feb 2005
Dopasowanie Komorki po raz DRUGI!

Teraz nie chodzi o dopasowanie jednej komórki tylko dwu komórek załóżmy $A$1 i $B$1 tylko ze one sa SCALONE!!!

Nijak mi to nie chce zadzialac...

Te dwie komórki po scaleniu mają adres $A$1
Próbując to zrobić tak:

With ThisWorkbook.Worksheets("arkusz1".Cells(1, 1)
        .Value = strTekst
        .WrapText = False 'zawijanie tekstu 
        .EntireColumn.AutoFit
        .WrapText = True  'zawijanie teksu
        .EntireRow.AutoFit
End With

niestety nic się nie dzieje...

Czy ktoś wie o co chodzi????

Wygląda mi to troche tak jakby nie można było dopasowywać komórek scalonych... Jeśli się mylę to proszę mnie wyprowadzić z błedu...


Pozdrawiam i czekam na jakieś sugestie...

02-04-2005 03:12
Pokaż profil Mroowek  Wyślij email do Mroowek        4892300
karolinavb




Typ: neutral
Postów: 468
Zarejestrowany: Jan 2003

Z tego co wiem Autofit ignoruje, jeśli tak można powiedzieć komórki połączone. Kiedyś znalazłam takie makro, które "sobie radzi" z tym problemem, symulując Autofit:


Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single
Dim MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single
Dim PossNewRowHeight As Single

Dim strTekst As String

strTekst = "Ala ma kota." & vbLf _
    & "Kot ma Alę." & vbLf _
    & "Tra-la-la" & vbLf _
    & "więc kto kogo tak naprawdę ma?."
'.Value = strTekst
With ThisWorkbook.Worksheets("arkusz1" ).Range("$A$1" )
    .Value = strTekst
    If .MergeCells Then
      With .MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
End With
End Sub

[Post edytowany dnia 02-04-2005 05:51 przez karolinavb]


_____________________________________________
Karolina

02-04-2005 05:50
Pokaż profil karolinavb  Wyślij email do karolinavb   
Mroowek




Typ: neutral
Postów: 51
Zarejestrowany: Feb 2005

Dzieki Karolino.

Przestudiowałem ten kodzik i niestety dzielił on tekst - ostatnią linijkę - nie ustawia szerokosci kolumn.

Wykożystałem kilka linijek z Twojego kodu i zrobiłem coś takiego:

Sub tekscik()
    Dim strTekst As String
    Dim SzerKol As Single, WysWier As Single
    Dim IleKomorek As Integer, IleWierszy As Integer
   
    strTekst = "Ala ma kota." & vbLf _
        & "Kot ma Alę." & vbLf _
        & "Tra-la-la" & vbLf _
        & "więc kto kogo tak naprawdę ma?."
   
    With ThisWorkbook.Worksheets("arkusz1".Range("$b$2"
        Application.ScreenUpdating = False
        IleKomorek = .MergeArea.Columns.Count
        IleWierszy = .MergeArea.Rows.Count
        .UnMerge
        .Value = strTekst
        .WrapText = False
        .EntireColumn.AutoFit
        .WrapText = True
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
        SzerKol = .ColumnWidth
        WysWier = .RowHeight
        With Range(.Address, .Offset(IleWierszy - 1, IleKomorek - 1).Address)
            .Merge
            .ColumnWidth = SzerKol / IleKomorek
            .RowHeight = WysWier / IleWierszy
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        Application.ScreenUpdating = True
    End With
End Sub


Dzięki tej procedurce, tekst rozdzielony vbLf nie jest dzielony w innych miejscach, a komórka jeśli jest scalona - tutaj o adresie $B$2 - to zostanie dopasowana do tekstu, a jeśli nie jest scalona to też zostanie dopasowana.
Wypróbuj, jeśli masz ochotę.

Dzieki i pozdrowionka

(`) - Świeczka dla Wielkiego Człowieka jakim był Jan Paweł II...
Oby pozostał w pamięci każdego z nas...


[Post edytowany dnia 03-04-2005 02:47 przez Mroowek]

03-04-2005 02:43
Pokaż profil Mroowek  Wyślij email do Mroowek        4892300
Reawer



Typ: neutral
Postów: 25
Zarejestrowany: Oct 2002

Przepraszam że wtrącam się w waszą dyskusję, ale żaden z waszych kodów nie działa u mnie.
Dlatego wymyśliłem taki kod:


Sub dopasowanie()
Dim kolumna As Single, wiersz As Single

strTekst = "Ala ma kota." & vbLf & "Kot ma Alę." & vbLf & "Tra-la-la" & vbLf & "więc kto kogo tak naprawdę ma?."
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("arkusz1".Cells(1, 1)
        .Value = strTekst
        .WrapText = False
        .EntireColumn.AutoFit
        .WrapText = True
        .EntireColumn.AutoFit
        End With
        Columns("A:A".Select
        kolumna = Selection.ColumnWidth
        Rows("1:1".Select
        wiersz = Selection.RowHeight
       
    Range("A1:B1".Select
    With Selection
        .HorizontalAlignment = xlCenter
        .ShrinkToFit = False
        .MergeCells = True
    End With
    Columns("A:B".Select
        Selection.ColumnWidth = kolumna / 2
        Rows("1:1".Select
        Selection.RowHeight = wiersz
        Range("a1".Select
Application.ScreenUpdating = True
End Sub


Dopasowuje kolumnę A i B w których są scalone komórki  A1 i B1.

NARA

04-04-2005 10:33
Pokaż profil Reawer  Wyślij email do Reawer   
Mroowek




Typ: neutral
Postów: 51
Zarejestrowany: Feb 2005

Witam.

Nie mam zielonego pojęcia, dlaczego nie działa to u Ciebie Reawer...
Dzieje się coś czy kompletnie nic???

U mnie Twój kodzik działa.

W moim przykładzie kod odnosi sie do komórki b2.
Zmień w kodzie komórkę b2 na a1:

...
...
With ThisWorkbook.Worksheets("arkusz1" ).Range("$a$1" )
...
...

a nastepnie w arkuszu 1 scal sobie kilka komorek poczynając od A1 (np  "A1:C3" ) i odpal kodzik.
Musi działać.

Pozdrawiam.

[Post edytowany dnia 04-04-2005 23:02 przez Mroowek]

04-04-2005 22:58
Pokaż profil Mroowek  Wyślij email do Mroowek        4892300
Reawer



Typ: neutral
Postów: 25
Zarejestrowany: Oct 2002

Działa również u mnie.
Dzięki za wytyczne.

NARA

05-04-2005 07:38
Pokaż profil Reawer  Wyślij email do Reawer   
Wszystkich odpowiedzi: 8 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1