Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
Zamknięty przez: Kaper
23-10-2019, 21:54
Udoskonalić makro
Autor Wiadomość
Krzysiek 
Stały bywalec Excelforum


Pomógł: 3 razy
Posty: 257
Wysłany: 18-10-2019, 09:54   Udoskonalić makro

Przedstawiam projekt opisany w arkuszu. Bardzo proszę o pomoc.
Pozdrawiam

Pierwszy_Projekt.xlsm
Pobierz Plik ściągnięto 63 raz(y) 31.73 KB

ID posta: 375716 Skopiuj do schowka
 
 
Patronus 
Excel Expert



Wersja: Win Office 365
Pomógł: 575 razy
Posty: 1649
Wysłany: 18-10-2019, 10:51   

Hej,

Przykładowy kod poniżej:

Kod:
Sub Makro2()
'
' Utw?rz wykresy
'Makro utworzone rejestratorem a potem zmodyfikowane

Dim i As Long

For i = 3 To 6
    ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
    ActiveChart.SetSourceData Source:=Range(Cells(6, i), Cells(10, i))
    ActiveChart.ChartTitle.Caption = Cells(5, i)
    ActiveChart.FullSeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$6:$B$10"
    Select Case i
        Case 3
            ActiveChart.Parent.Top = 220
            ActiveChart.Parent.Left = 40
        Case 4
            ActiveChart.Parent.Top = 220
            ActiveChart.Parent.Left = 540
        Case 5
            ActiveChart.Parent.Top = 480
            ActiveChart.Parent.Left = 40
        Case 6
            ActiveChart.Parent.Top = 480
            ActiveChart.Parent.Left = 540
    End Select
Next i
   
End Sub
ID posta: 375717 Skopiuj do schowka
 
 
Krzysiek 
Stały bywalec Excelforum


Pomógł: 3 razy
Posty: 257
Wysłany: 18-10-2019, 11:20   

Jeszcze drobiazg.
A czy można jakoś automatycznie wstawiać ilości przy słupkach?
ID posta: 375719 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 18-10-2019, 11:46   

Testuj:
Kod:
Sub Makro2()
    Dim My_Chart         As Shape
    Dim Off_r            As Byte
    Dim Off_c            As Byte
    Dim Rng_kat          As Excel.Range
    Dim Rng_data         As Excel.Range
    Dim sTtitle          As String
    Dim i                As Byte

    Set Rng_kat = ActiveSheet.Range("B6:B10")

    For i = 0 To 3
        Set Rng_data = ActiveSheet.Range("C6:C10").Offset(0, i)
        sTtitle = ActiveSheet.Range("C5").Offset(0, i)

        Set My_Chart = ActiveSheet.Shapes.AddChart2(216, xlBarClustered, Range("B16").Offset(Off_r, Off_c).Left, Range("B16").Offset(Off_r, Off_c).Top)
        My_Chart.Chart.SetSourceData Source:=Range("" & Rng_kat.Address & "," & Rng_data.Address & "")
        My_Chart.Chart.ChartTitle.Text = sTtitle
        My_Chart.Chart.FullSeriesCollection(1).ApplyDataLabels

        If i Mod 2 = 0 Then
            Off_c = 8
        Else
            Off_r = Off_r + 16: Off_c = 0
        End If
    Next i

End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 375721 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4178 razy
Posty: 7785
Wysłany: 21-10-2019, 10:20   

I pomyśl (ja nie zaglądałem do pliku, więc nie podpowiem) jak zmienić temat, żeby opisywał to, co faktycznie jest Twoim celem, tak, aby ktoś, kto korzysta z http://www.excelforum.pl/search.htm (mam nadzieję, że Ty przed zadaniem pytania skorzystałeś) widział, że warto do tego tematu zajrzeć. W ramach wyjaśnienia - poczytaj p.1.4 i 2.1 (drugie zdanie) naszego http://www.excelforum.pl/regulamin.htm

Jeśli nie możesz już zmienić samodzielnie (od opublikowania tematu mionęły 3 dni) - wpisz propozycję tutaj - ktoś z moderatorów lub adminów chętnie zmieni tytuł wątku.
_________________
Kaper Jej Królewskiej Mości :boss

Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego
ID posta: 375800 Skopiuj do schowka
 
 
Krzysiek 
Stały bywalec Excelforum


Pomógł: 3 razy
Posty: 257
Wysłany: 23-10-2019, 15:41   

Jeszcze pytanie do forumowicza (moderatora) Marecki-ego.
Jak przerobić fragment kodu:
Kod:
If i Mod 2 = 0 Then
            Off_c = 8
        Else
            Off_r = Off_r + 16: Off_c = 0
        End If

aby wykresy na arkuszu zamiast (dla i=0 To 3) w dwóch rzędach po dwa wykresy,
to dla (i=0 To 5 dodałem dwie kolumny danych) makro zwracało po trzy wykresy w dwóch rzędach.
Pozdrawiam
ID posta: 375908 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4178 razy
Posty: 7785
Wysłany: 23-10-2019, 21:54   

Ale najpierw - zmiana tematu (teraz już przez prywatne wiadomości lub wpis w shoutboxie na stronie startowej).

Bo, żeby nikogo nie korciło odpisywanie mimo zignorowania prośby administratora - zamykam temat.
_________________
Kaper Jej Królewskiej Mości :boss

Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego
ID posta: 375922 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Ten temat jest zablokowany bez możliwości zmiany postów lub pisania odpowiedzi
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe