VBA i rysowanie krzyża

Dla specjalistów Programowanie
#1

Witam. Nie mogę sobie poradzić z pewną procedurą VBA i szukam pomocy. Jestem początkujący także nie bardzo wiem co mogę zrobić.

Oto treść:

Na chwilę obecną mam to:

Sub krzyz()

Dim obszar As Range


Set obszar = Selection

obszar.Interior.Color = vbYellow



pw = obszar.Row

pk = obszar.Column

Range(Cells(pw - 3, pk), Cells(pw + 3, pk)).Interior.Color = vbBlack

Range(Cells(pw, pk - 3), Cells(pw, pk + 3)).Interior.Color = vbBlack




End Sub

Maluje mi to zaznaczony obszar na żółto a krzyż na czarno jednak krzyż ma być po środku, a u mnie tylko zachodzi na pomalowany obszar. To ustawienie gdzie ma być krzyż skopiowałem z innego zadania gdzie po prostu maluje krzyż o stałym rozmiarze. I tutaj pytanie. Jak zmienić kawałek kodu:

Range(Cells(pw - 3, pk), Cells(pw + 3, pk)).Interior.Color = vbBlack

Range(Cells(pw, pk - 3), Cells(pw, pk + 3)).Interior.Color = vbBlack

, aby krzyż był malowany po środku zaznaczonego obszaru?

Z góry dziękuję za pomoc!

Przemek.

#2

Powinno działać:

Sub krzyz()

    Dim obszar As Range

    Set obszar = Selection

    obszar.Interior.Color = vbYellow

    pw = obszar.Row

    pk = obszar.Column

   wierszy = obszar.Rows.Count

   kolumn = obszar.Columns.Count

  Range(Cells(pw, pk + (kolumn - 1) / 2), Cells(pw + wierszy - 1, pk + (kolumn - 1) / 2)).Interior.Color = vbBlack

Range(Cells(pw + (wierszy - 1) / 2, pk), Cells(pw + (wierszy - 1) / 2, pk + kolumn - 1)).Interior.Color = vbBlack

    End Sub
#3

Działa, dziękuję bardzo! Tylko mam jedno pytanie? czy

wierszy = obszar.Rows.Count

   kolumn = obszar.Columns.Count

Ta linia służy do zliczania kolumn i wierszy?

#4

liczba zaznaczonych wierszy / kolumn

#5

Programik można rozszerzyć np. tak:

Jeżeli liczba wierszy lub kolumn jest parzysta lub równa 1 to można ich liczbę zwiększyć o jeden aby była nieparzysta i większa od 1.

Dim obszar As Range

wierszy = Selection.Rows.Count

kolumn = Selection.Columns.Count

If wierszy < 2 Then wierszy = 2

If kolumn < 2 Then kolumn = 2

Set obszar = Selection

If wierszy / 2 = Int(wierszy / 2) Then

wierszy = wierszy + 1

obszar.Offset(0, 0).Resize(wierszy, kolumn).Select

End If

If kolumn / 2 = Int(kolumn / 2) Then

kolumn = kolumn + 1

obszar.Offset(0, 0).Resize(wierszy, kolumn).Select

End If

Set obszar = Selection

obszar.Interior.Color = vbYellow

pw = obszar.Row

pk = obszar.Column

Range(Cells(pw, pk + (kolumn - 1) / 2), Cells(pw + wierszy - 1, pk + (kolumn - 1) / 2)).Interior.Color = vbBlack

Range(Cells(pw + (wierszy - 1) / 2, pk), Cells(pw + (wierszy - 1) / 2, pk + kolumn - 1)).Interior.Color = vbBlack