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
ID tematu: 70514 Skopiuj do schowka Wywołanie userForm dla scalonej komórki
Autor Wiadomość
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 26-03-2021, 11:49   Wywołanie userForm dla scalonej komórki

Witam
W moim pliku uruchamiam userform po najechaniu na komórkę. Działa to dzięki wskazówkom z forum bardzo dobrze. Załączony plik (Kalkulacja 2021-06-26)
Chciałbym to zmodyfikować, żeby niektóre zakresy były scalone jak w drugim pliku.
Chodzi o arkusz specyfikacja i scalone zakresy:

O3:R3, O4:R:$, O5:R5,S3:T3, S4:T4, S5:T5 oraz O13:R13 (Kalkulacja 2021-03-26a)

Moje próby nic nie dają.
Może ktoś udzieli jakiś wskazówek, jeżeli dla mojego przypadku jest możliwe.
Kod:
Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count = 1 Then

        If Not Intersect(Target, Range("D1,D2")) Is Nothing Then
            frmKalendarz.Show

        'ElseIf Not Intersect(Target, Range("T31")) Is Nothing Then
            'Vat.Show

        'ElseIf Not Intersect(Target, Range("E21")) Is Nothing Then
            'Zaliczka.Show
           
         
           
           'ElseIf Not Intersect(Target, Union(Range("E21"), _
                                          , Range("T31"))) Is Nothing Then
                                         
           ElseIf Not Intersect(Target, Range("E21,T31")) Is Nothing Then

            With Frm_Zal
            Select Case Target.Address(0, 0)
                Case "E21"
                    Set .rngZakres = Worksheets("nazwy1").Range("L3:L12")
                    .Caption = "Zaliczka"
                    '.cmdCancel.BackColor = &HC0FFFF
                Case "T31"
                    Set .rngZakres = Worksheets("nazwy1").Range("U13:U15")
                    .Caption = "VAT"
                    '.cmdCancel.BackColor = &H80FFFF
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With
               
               
               
           
           

        ElseIf Not Intersect(Target, Range("S3:S5,D13,O13")) Is Nothing Then

            With FRM_kl
                Select Case Target.Address(0, 0)
                    Case "S3"
                        .Caption = "Kl_prostokątne"
                        Set .rngZakres = Worksheets("nazwy1").Range("F2:F25")
                    Case "S4"
                        .Caption = "Kl kołowe"
                        Set .rngZakres = Worksheets("nazwy1").Range("D30:D43")
                    Case "S5"
                        .Caption = "Kl osprzęt"
                        Set .rngZakres = Worksheets("nazwy1").Range("F30:F43")
                    Case "D13"
                        .Caption = "Odbiorcy"
                        .cmdCancel.BackColor = &HFF&
                        .cmdCancel.Width = 138
                        .TextBox1.Width = 138
                        .ListBox1.Width = 138
                        Set .rngZakres = Worksheets("odbiorcy").Range("H2:H1001")
                        .Width = 208.5
                    Case "O13"
                        .Caption = "Pracownicy"
                        .cmdCancel.BackColor = &HFFC0C0
                        Set .rngZakres = Worksheets("nazwy1").Range("A3:A17")
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With

        ElseIf Not Intersect(Target, Union(Range("B1,B2,E1,E2,S1,S2"), _
                                           Range("B3,N6"), _
                                           Range("F25,F27,F28,I22"), _
                                           Range("E22"), Range("H22"), _
                                           Range("O3"), Range("O4"), _
                                           Range("V3"), Range("V4"), _
                                           Range("V5"), Range("U4"), _
                                           Range("U5"), Range("O5"), _
                                           Range("O6"), Range("R6"), _
                                           Range("U6"), Range("W6"), _
                                           Range("AE11"), Range("AE12"))) Is Nothing Then

            With Frm_Uni
                Select Case Target.Address(0, 0)
                    Case "B1", "B2", "E1", "E2", "S1", "S2"
                        Set .rngZakres = Worksheets("nazwy1").Range("J9:J20")
                        .Caption = "Nr"
                    Case "B3", "N6"
                        Set .rngZakres = Worksheets("nazwy1").Range("O27:O28")
                        .Caption = "Oferta / zamówienie"
                    Case "F25", "F27", "F28", "I22"
                        Set .rngZakres = Worksheets("nazwy1").Range("K15:K19")
                        .Caption = "Termin jedn"
                    Case "E22"
                        Set .rngZakres = Worksheets("nazwy1").Range("J3:J6")
                        .Caption = "Płatność"
                        .cmdCancel.BackColor = &HC0C000
                    Case "H22"
                        Set .rngZakres = Worksheets("nazwy1").Range("K3:K12")
                        .Caption = "Termin"
                        .cmdCancel.BackColor = &HC0C000
                    Case "O3"
                        Set .rngZakres = Worksheets("nazwy1").Range("P3:P5")
                        .Caption = "Normy prostokątne"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "O4"
                        Set .rngZakres = Worksheets("nazwy1").Range("Q3:Q5")
                        .Caption = "Normy kołowe"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "V3"
                        Set .rngZakres = Worksheets("nazwy1").Range("N8:N11")
                        .Caption = "KO prostokątne"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "V4"
                        Set .rngZakres = Worksheets("nazwy1").Range("N13:N16")
                        .Caption = "KO kołowe"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "V5"
                        Set .rngZakres = Worksheets("nazwy1").Range("N18:N21")
                        .Caption = "KO osprzęt"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "U4"
                        Set .rngZakres = Worksheets("nazwy1").Range("O14:O16")
                        .Caption = "Uszcz / koł kołowe"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "U5"
                        Set .rngZakres = Worksheets("nazwy1").Range("O19:O21")
                        .Caption = "Uszcz / koł osprzęt"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "O5"
                        Set .rngZakres = Worksheets("nazwy1").Range("R3:R5")
                        .Caption = "Normy osprzęt"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "O6"
                        Set .rngZakres = Worksheets("nazwy1").Range("M3:M5")
                        .Caption = "Sposób liczenia"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "R6"
                        Set .rngZakres = Worksheets("nazwy1").Range("N3:N4")
                        .Caption = "Zaokrąglenie"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "U6"
                        Set .rngZakres = Worksheets("nazwy1").Range("O3:O4")
                        .Caption = "Kanał / kszt"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "W6"
                        Set .rngZakres = Worksheets("nazwy1").Range("M8:M9")
                        .Caption = "Ceny podział"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "AE11"
                        Set .rngZakres = Worksheets("nazwy1").Range("G9:G18")
                        .Caption = "Izolacja wewnętrzna"
                        .cmdCancel.BackColor = &HC0FFFF
                    Case "AE12"
                        Set .rngZakres = Worksheets("nazwy1").Range("H9:H14")
                        .Caption = "Preizolacja"
                        .cmdCancel.BackColor = &H80FFFF
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With

        End If

    End If
End Sub


Będę wdzięczny za wskazówki
Pozdrawiam

Kalkulacja 2021-03-26.rar
Plik bez scalonych komórek
Pobierz Plik ściągnięto 5 raz(y) 715.53 KB

Kalkulacja 2021-03-26a.rar
Plik ze scalonymi komórkami
Pobierz Plik ściągnięto 5 raz(y) 725.03 KB

ID posta: 402770 Skopiuj do schowka
 
 
Tajan


Pomógł: 4767 razy
Posty: 10469
Wysłany: 26-03-2021, 13:42   

W kodzie masz ograniczenie nie zezwalające na uruchomienie makra gdy zaznaczona jest więcej niż jedna komórka:
Kod:
If Target.Count = 1 Then
W obszarze scalonym komórek jest więcej, więc należałoby dodać wyjątek dla danych adresów. Np. :
Kod:
If Target.Count = 1 Or Target.Address = "$O$3:$R$3" Or Target.Address = "$O$4:$R$4" Then

Również w dalszej części kodu, warunki w rodzaju:
Kod:
Case "O3"
należałoby zmienić na
Kod:
Case "O3:R3"
ID posta: 402773 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 27-03-2021, 08:32   

Dziękuję
Pozdrawiam
ID posta: 402814 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 28-03-2021, 10:51   

Witam
zrobiłem wg Twoich wskazówek,
Dla zakresów:
O3:R3, O4:R4, O5:R5
S3:T3, S4:T4, S5:T5
działa

ale dla zakresu:
O13:R13
nie działa

Co tu trzeba jeszcze poprawić?
W załączeniu plik

Kod:
Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count = 1 Or Target.Address = "$O$3:$R$3" Or Target.Address = "$O$4:$R$4" Or Target.Address = "$O$5:$R$5" Or Target.Address = "$S$3:$T$3" Or Target.Address = "$S$4:$T$4" Or Target.Address = "$S$5:$T$5" Or Target.Address = "$O2$13:$R$13" Then
        If Not Intersect(Target, Range("D1,D2")) Is Nothing Then
            frmKalendarz.Show

        'ElseIf Not Intersect(Target, Range("T31")) Is Nothing Then
            'Vat.Show

        'ElseIf Not Intersect(Target, Range("E21")) Is Nothing Then
            'Zaliczka.Show
           
         
           
           'ElseIf Not Intersect(Target, Union(Range("E21"), _
                                          , Range("T31"))) Is Nothing Then
                                         
           ElseIf Not Intersect(Target, Range("E21,T31")) Is Nothing Then

            With Frm_Zal
            Select Case Target.Address(0, 0)
                Case "E21"
                    Set .rngZakres = Worksheets("nazwy1").Range("L3:L12")
                    .Caption = "Zaliczka"
                    '.cmdCancel.BackColor = &HC0FFFF
                Case "T31"
                    Set .rngZakres = Worksheets("nazwy1").Range("U13:U15")
                    .Caption = "VAT"
                    '.cmdCancel.BackColor = &H80FFFF
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With
               
               
               
           
           

        ElseIf Not Intersect(Target, Range("S3:T3,S4:T4,S5:T5,D13,O13:R13")) Is Nothing Then

            With FRM_kl
                Select Case Target.Address(0, 0)
                    Case "S3:T3"
                        .Caption = "Kl_prostokątne"
                        Set .rngZakres = Worksheets("nazwy1").Range("F2:F25")
                    Case "S4:T4"
                        .Caption = "Kl kołowe"
                        Set .rngZakres = Worksheets("nazwy1").Range("D30:D43")
                    Case "S5:T5"
                        .Caption = "Kl osprzęt"
                        Set .rngZakres = Worksheets("nazwy1").Range("F30:F43")
                    Case "D13"
                        .Caption = "Odbiorcy"
                        .cmdCancel.BackColor = &HFF&
                        .cmdCancel.Width = 138
                        .TextBox1.Width = 138
                        .ListBox1.Width = 138
                        Set .rngZakres = Worksheets("odbiorcy").Range("H2:H1001")
                        .Width = 208.5
                    Case "O13:R13"
                        .Caption = "Pracownicy"
                        .cmdCancel.BackColor = &HFFC0C0
                        Set .rngZakres = Worksheets("nazwy1").Range("A3:A17")
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With

        ElseIf Not Intersect(Target, Union(Range("B1,B2,E1,E2,S1,S2"), _
                                           Range("B3,N6"), _
                                           Range("F25,F27,F28,I22"), _
                                           Range("E22"), Range("H22"), _
                                           Range("O3:R3"), Range("O4:R4"), _
                                           Range("V3"), Range("V4"), _
                                           Range("V5"), Range("U4"), _
                                           Range("U5"), Range("O5:R5"), _
                                           Range("O6"), Range("R6"), _
                                           Range("U6"), Range("W6"), _
                                           Range("AE11"), Range("AE12"))) Is Nothing Then

            With Frm_Uni
                Select Case Target.Address(0, 0)
                    Case "B1", "B2", "E1", "E2", "S1", "S2"
                        Set .rngZakres = Worksheets("nazwy1").Range("J9:J20")
                        .Caption = "Nr"
                    Case "B3", "N6"
                        Set .rngZakres = Worksheets("nazwy1").Range("O27:O28")
                        .Caption = "Oferta / zamówienie"
                    Case "F25", "F27", "F28", "I22"
                        Set .rngZakres = Worksheets("nazwy1").Range("K15:K19")
                        .Caption = "Termin jedn"
                    Case "E22"
                        Set .rngZakres = Worksheets("nazwy1").Range("J3:J6")
                        .Caption = "Płatność"
                        .cmdCancel.BackColor = &HC0C000
                    Case "H22"
                        Set .rngZakres = Worksheets("nazwy1").Range("K3:K12")
                        .Caption = "Termin"
                        .cmdCancel.BackColor = &HC0C000
                    Case "O3:R3"
                        Set .rngZakres = Worksheets("nazwy1").Range("P3:P5")
                        .Caption = "Normy prostokątne"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "O4:R4"
                        Set .rngZakres = Worksheets("nazwy1").Range("Q3:Q5")
                        .Caption = "Normy kołowe"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "V3"
                        Set .rngZakres = Worksheets("nazwy1").Range("N8:N11")
                        .Caption = "KO prostokątne"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "V4"
                        Set .rngZakres = Worksheets("nazwy1").Range("N13:N16")
                        .Caption = "KO kołowe"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "V5"
                        Set .rngZakres = Worksheets("nazwy1").Range("N18:N21")
                        .Caption = "KO osprzęt"
                        .cmdCancel.BackColor = &HFFC0C0
                    Case "U4"
                        Set .rngZakres = Worksheets("nazwy1").Range("O14:O16")
                        .Caption = "Uszcz / koł kołowe"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "U5"
                        Set .rngZakres = Worksheets("nazwy1").Range("O19:O21")
                        .Caption = "Uszcz / koł osprzęt"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "O5:R5"
                        Set .rngZakres = Worksheets("nazwy1").Range("R3:R5")
                        .Caption = "Normy osprzęt"
                        .cmdCancel.BackColor = &H808080
                        .cmdCancel.ForeColor = &H8000000E
                    Case "O6"
                        Set .rngZakres = Worksheets("nazwy1").Range("M3:M5")
                        .Caption = "Sposób liczenia"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "R6"
                        Set .rngZakres = Worksheets("nazwy1").Range("N3:N4")
                        .Caption = "Zaokrąglenie"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "U6"
                        Set .rngZakres = Worksheets("nazwy1").Range("O3:O4")
                        .Caption = "Kanał / kszt"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "W6"
                        Set .rngZakres = Worksheets("nazwy1").Range("M8:M9")
                        .Caption = "Ceny podział"
                        .cmdCancel.BackColor = &HE0E0E0
                    Case "AE11"
                        Set .rngZakres = Worksheets("nazwy1").Range("G9:G18")
                        .Caption = "Izolacja wewnętrzna"
                        .cmdCancel.BackColor = &HC0FFFF
                    Case "AE12"
                        Set .rngZakres = Worksheets("nazwy1").Range("H9:H14")
                        .Caption = "Preizolacja"
                        .cmdCancel.BackColor = &H80FFFF
                End Select

                .cmdCancel.Cancel = True
                .Show
            End With

        End If

    End If
End Sub


Będę wdzięczny za wskazówko
Pozdrawiam

Kalkulacja 2021-03-28.rar
Pobierz Plik ściągnięto 6 raz(y) 726.88 KB

ID posta: 402855 Skopiuj do schowka
 
 
Tajan


Pomógł: 4767 razy
Posty: 10469
Wysłany: 28-03-2021, 16:07   

Masz literówkę w warunku:
Kod:
Target.Address = "$O2$13:$R$13"
Ta dwójka po "O" jest zbędna :-)
ID posta: 402861 Skopiuj do schowka
 
 
Ayala 
Exceloholic


Wersja: Win Office 2019
Posty: 206
Wysłany: 28-03-2021, 16:07   

Witam
Wielkie dzięki równolegle znalazłem ten błąd błąd. Zamiast $O$13:$R$13 napisałem $O2$13:$R$13. :angry :oops:
Przepraszam za zamieszanie. Wszystko działa bez zarzutu.


Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count = 1 Or Target.Address = "$O$3:$R$3" Or Target.Address = "$O$4:$R$4" Or Target.Address = "$O$5:$R$5" Or Target.Address = "$S$3:$T$3" Or Target.Address = "$S$4:$T$4" Or Target.Address = "$S$5:$T$5" Or Target.Address = "$O$13:$R$13" Then


Pozdrawiam
ID posta: 402862 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
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