• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

[ÇÖZÜLDÜ] Makro ile kenarlık

  • Konbuyu başlatan Konbuyu başlatan Maksim
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
M

Maksim

Katılım
21 Haziran 2007
Mesajlar
97
Excel Vers. ve Dili
Rusca 2003
Herkese Merhaba!
Makro ile yapılan kenarıklarla ilgili döküman arıyorum.

Ya da böyle bir kenarlığı makro ile nasıl cize bilirim?
50743.jpg

B11 Değişken..Yani B15, B18 V s. De bite bilir
Elinizde varsa paylaşmanızı rica ediyorum
 
toplam c7 ye değilde c11 e neden alınıyor...
verilerin bittiği satır+ 5 e mi alaınacak.
 
Kod: 
Sub Makro1()
Dim CSf As Worksheet
Set CSf = ThisWorkbook.Worksheets("Test")
kenarliklarisifirla:
    CSf.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
kenarlikciz:
    sonsat = CSf.Cells(65536, 2).End(3).Row + 1
    CSf.Range("A2:C" & sonsat).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    CSf.Range("A" & sonsat & ":C" & sonsat).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ToplamAl:
    CSf.Range("A" & sonsat).Value = " TOPLAM"
    CSf.Range("A" & sonsat).Font.Bold = True
    CSf.Range("B" & sonsat).Value = "=SUM(B2:B" & sonsat - 1 & ")"
    CSf.Range("B" & sonsat).Font.Bold = True
hafızayısil:
Set CSf = Nothing
End Sub
 
Evet hocam.Aynen düşündüyünüz kibi...+5.Boş olan yerlere her an veri girile bilir.Veri girilmesi Borc-Alacak durumundan aslıdır.Borc -Alacağa kecdiyi zaman boş olan setirlere veri otomatik SQL den gelecek
 
Maksim' Alıntı:
Evet hocam.Aynen düşündüyünüz kibi...+5.Boş olan yerlere her an veri girile bilir.Veri girilmesi Borc-Alacak durumundan aslıdır.Borc -Alacağa kecdiyi zaman boş olan setirlere veri otomatik SQL den gelecek
Genişletmek için tıkla ...
Kod: 
Sub Makro1()
Dim CSf As Worksheet
Set CSf = ThisWorkbook.Worksheets("[COLOR=red]Test[/COLOR]")       'Çalışma sayfanızın adını yazınız.
kenarliklarisifirla:
    CSf.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = False
kenarlikciz:
    sonsat = CSf.Cells(65536, 2).End(3).Row + [COLOR=red]6       'kaç satır boşluk vermek istiyorsanız o kadar artınız.[/COLOR]
    CSf.Range("A2:C" & sonsat).Select
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    CSf.Range("A" & sonsat & ":C" & sonsat).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ToplamAl:
    CSf.Range("A" & sonsat).Value = " TOPLAM"
    CSf.Range("A" & sonsat).Font.Bold = True
    CSf.Range("B" & sonsat).Value = "=SUM(B2:B" & sonsat - 1 & ")"
    CSf.Range("B" & sonsat).Font.Bold = True
End Sub
 
mükerrer gönderim.
 
bu daha güzel oldu

Kod: 
Sub Makro1()
Dim CSf As Worksheet
Set CSf = ThisWorkbook.Worksheets("maksim_kenarlik") 'kendiçalımasayfanızınafını yazınız
Dim EskSat, SonSat As Double, ArnnKlm As String
EskiToplamlariSil:
    EskSat = 0: ArnnKlm = " TOPLAM"
    On Error Resume Next
    EskSat = CSf.Columns("A:A").Find(What:=ArnnKlm, LookAt:=xlWhole).Row
    On Error GoTo 0
    If EskSat > 0 Then
        CSf.Range("A" & EskSat & ":C" & EskSat).ClearContents
        GoTo EskiToplamlariSil
    Else
        GoTo kenarliklarisifirla
    End If
kenarliklarisifirla:
    CSf.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = False
kenarlikciz:
    SonSat = CSf.Cells(65536, 2).End(3).Row + 6      'Ne kadar boş satır kalacaksa o oranda artırınız.
    CSf.Range("A2:C" & SonSat).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    CSf.Range("A" & SonSat & ":C" & SonSat).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ToplamAl:
    CSf.Range("A" & SonSat).Value = ArnnKlm
    CSf.Range("A" & SonSat).Font.Bold = True
    CSf.Range("B" & SonSat).Value = "=SUM(B2:B" & SonSat - 1 & ")"
    CSf.Range("B" & SonSat).Font.Bold = True
End Sub

SonSat değişkenini belirken aşağıdaki satırı kullanırsanız 5 dolu satır varsa 5 boş eklenir, 10 dolu varsa 10 boş eklenir. ;)
[/code] ......
SonSat = CSf.Cells(65536, 2).End(3).Row + (CSf.Cells(65536, 2).End(3).Row - 1)
.....[/code]
 
Son düzenleme:
Makronu çalışdırdıkda hata veriyor
Run-Time error 438
Object doesn't support this or method
.TintAndShade = 0
Size deyerli zamanınızı bana ayırdiğınız için teşekkür ediyorum
 
Maksim' Alıntı:
Makronu çalışdırdıkda hata veriyor
Run-Time error 438
Object doesn't support this or method
.TintAndShade = 0
Size deyerli zamanınızı bana ayırdiğınız için teşekkür ediyorum
Genişletmek için tıkla ...

exel2007'de dediğininiz hata yok ancak ".tint" ile başlayan satırları alt versiyonlarda kladırmakta fayda var.
Daha evvel bende de hata veriyordu.

Kod: 
Sub Makro1()
Dim CSf As Worksheet
Set CSf = ThisWorkbook.Worksheets("maksim_kenarlik") 'kendiçalımasayfanızınafını yazınız
Dim EskSat, SonSat As Double, ArnnKlm As String
EskiToplamlariSil:
    EskSat = 0: ArnnKlm = " TOPLAM"
    On Error Resume Next
    EskSat = CSf.Columns("A:A").Find(What:=ArnnKlm, LookAt:=xlWhole).Row
    On Error GoTo 0
    If EskSat > 0 Then
        CSf.Range("A" & EskSat & ":C" & EskSat).ClearContents
        GoTo EskiToplamlariSil
    Else
        GoTo kenarliklarisifirla
    End If
kenarliklarisifirla:
    CSf.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = False
kenarlikciz:
    SonSat = CSf.Cells(65536, 2).End(3).Row + 6      'Ne kadar boş satır kalacaksa o oranda artırınız.
    CSf.Range("A2:C" & SonSat).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlThin
    End With
 
    CSf.Range("A" & SonSat & ":C" & SonSat).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ToplamAl:
    CSf.Range("A" & SonSat).Value = ArnnKlm
    CSf.Range("A" & SonSat).Font.Bold = True
    CSf.Range("B" & SonSat).Value = "=SUM(B2:B" & SonSat - 1 & ")"
    CSf.Range("B" & SonSat).Font.Bold = True
End Sub



örnek dosya ekliyorum(güncellendi)
 
Son düzenleme:
Maksim' Alıntı:
Teşekkür ederim Hocam!
Genişletmek için tıkla ...

Rica ederim. EskitoplamlairSil kısmı bana göre ilkel bir yöntemdi doğrusunu öğrenip güncelledim. Arzu ederseniz aşğaıdaki gibide kullanabilirsiniz.
bu arada konuyu çözüldü olarak işaretlerseniz iyi olacaktır.

Kod: 
Sub Makro1()
Dim CSf As Worksheet
Set CSf = ThisWorkbook.Worksheets("maksim_kenarlik") 'kendiçalımasayfanızınafını yazınız
[COLOR=green]Dim SonSat As Double
[/COLOR]    
[COLOR=green]    Set Stn = CSf.Range("A:A")
    With Stn
        Set Hcr = .Find("TOPLAM", LookIn:=xlValues, MatchCase:=False)
        If Not Hcr Is Nothing Then
            Do
                CSf.Range("A" & Hcr.Row & ":C" & Hcr.Row).ClearContents
                Set Hcr = .FindNext(Hcr)
            Loop While Not Hcr Is Nothing
        End If
    End With
    Set Stn = Nothing[/COLOR]
kenarliklarisifirla:
    CSf.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = False
kenarlikciz:
    SonSat = CSf.Cells(65536, 2).End(3).Row + 6      'Ne kadar boş satır kalacaksa o oranda artırınız.
    CSf.Range("A2:C" & SonSat).Select
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    
    CSf.Range("A" & SonSat & ":C" & SonSat).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
       .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ToplamAl:
    CSf.Range("A" & SonSat).Value = "TOPLAM"
    CSf.Range("A" & SonSat).Font.Bold = True
    CSf.Range("B" & SonSat).Value = "=SUM(B2:B" & SonSat - 1 & ")"
    CSf.Range("B" & SonSat).Font.Bold = True
End Sub
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst