Excel'de çizim yapma.(CM olarak)

[hamitcan]

Tüm şekilleri başka bir sayfaya mı aktarıyorsunuz ?

 

[şiraz1]

sadece benim belirlediklerimi örneğin 39008483 kodlu malzemenin şeklini ölçüler sayfasından kopyalıyorum yükleme sayfasına sipariş adetine göre kaç balya gerekliyse ör:bir balya(39008483 250pcs)siparişi 500 adet ise bu şekilden 2 tane yükleme sayfasına yapıştırıyorum bundan dolayı sipariş niktarına göre şekil sayısı arttıkça tır olarak düşünürsek şekillerin aralarındaki boşlukları teker teker ayarlamak gerekiyor birde çok sağlıklı olmuyor zaten benim yaptığım gibi;aslında bunu yükleme sayfasında açılır liste gelsede ölçüler sayfasında koda göre kayıtlı olan malzeme yükleme sayfasına gelse daha süper olur ama

 

[hamitcan]

O zaman, tüm şekilleri yeniden isimlendirmek daha iyi olacak kanımca. Böyle olursa da diğer sayfaya şekli çağırmak daha kolay olacaktır. Bundan sonra ise her bir tırın içine bu şekilleri yerleştirmek gerekiyor tabii ki, böyle bir kodu yazmak da benim için epey zaman alacaktır.

 

[şiraz1]

aslında çoğu tanımlı fakat bunu yapabilirsek çok süper olur eğer mümkünse,
saygılar sizden haber bekliyorum ilginiz için gerçekten çok saol eline bileğine emeğine sağlık

 

[hamitcan]

Bazı şekillerin isimlerini, içeriği ile eşitledim ve bir veri doğrulama listesi oluşturdum. Siz de diğer şekilleri bu şekilde değiştirin. Ayrıca şekil oluşturma ile ilgili koda bu şekilde bir eklenti (şekillerin isimleri ile içeriği eşitlenebilir.) de yapılabilir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$U$1" Then Exit Sub
Sheets("ÖLÇÜLER").Shapes(Target.Text).Copy
    If [Z1] = "TIR1" Then
        y = 87
    ElseIf [Z1] = "TIR2" Then
        y = 418.25
    ElseIf [Z1] = "TIR3" Then
        y = 724.25
    End If
    With ActiveSheet
            .Paste
            For Each shp In .Shapes
               If shp.Top = y Then
               a = shp.Name
               End If
            Next
            If s = 0 Then
                Selection.Top = y
                Selection.Left = 50
            Else
                Selection.Top = y
                Selection.Left = .Shapes(a).Width + .Shapes(a).Left
            End If
    End With
End Sub

 

[şiraz1]

hocam şekillere isim vermeyi nasıl yaptınız kısaca açıklarmısınız

 

[hamitcan]

Resmi inceleyin.

 

[şiraz1]

teşekkür

sn hamitcan
bana yardımcı olduğunuz için çok teşekkürler emeğinize sağlık
:bravo:

 

[şiraz1]

sn hamitcan

bir konu da yardıma ihtiyacım var
son gönderdiğiniz dosyayı hatırlarsanız yükleme sayfasında 3 adet tır bulunmaktaydı veiçlerinde değişik ölçülerde bulunan şekiller vardı.Benim sorunum şöyle bu üç tır içerisinde hangişekilden hangi tır içerisinde kaç tane vardır bunu makro yardımıyla saydırabilirmiyiz ör: şeklinden 1..tırda 10 adet vardır 2.tırda 5 adet vardır v.b gibi şimdiden teşekkürler

 

[hamitcan]

İsim olarak mı boyut olarak mı ?

 

[şiraz1]

isim olarak ör:şeklin ismi;3900xx 1.tırda ... adet vardır 2.tırda ...adet vardır gibi.Burda zaten şekillerin üzerine metin yazacağım için boyuta gerek yok yapmak istediğim şu:toplamda tırlar içerisinde hangi şekilden kaç tane vardır öğrenmek..

 

[hamitcan]

Ozaman, öncelikle bir liste hazırlayın kaç şekil olduğunu gösterir, sonrası kolay.

 

[şiraz1]

ekte gönderiyorum yükleme sayfasında tır şekillerinin altında iki tablo var oraya şekil sayılarını getirtebilirmiyiz?

 

[hamitcan]

Cm Olarak Şekil Çizme

Sub CmOlarakSekilCizme3()
    Dim g As Double, y As Double, z As Double
    Dim myDocument As Worksheet
    g = InputBox("Ondalık Kısmında Nokta '.' Karakterini Kullanın", "Genişliği Cm Olarak Girin")
    y = InputBox("Ondalık Kısmında Nokta '.' Karakterini Kullanın", "Yüksekliği Cm Olarak Girin")
    Set myDocument = Worksheets(1)
On Error Resume Next
With myDocument
    z = .Shapes(.Shapes.Count).Width + .Shapes(.Shapes.Count).Left + 20
        .Shapes.AddShape msoShapeRectangle, z, 0, (g * 72 / 2.54), (y * 72 / 2.54)
        .Shapes(.Shapes.Count).TextFrame.Characters.Text = "Gen :" & g & Chr(10) & "Yük :" & y
        .Shapes(.Shapes.Count).TextFrame.Characters.Font.Size = g * y + 4
End With
End Sub

Şekil Çağırma

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$U$1" Then Exit Sub
Sheets("ÖLÇÜLER").Shapes(Target.Text).Copy
    If [Z1] = "TIR1" Then
        y = 87
    ElseIf [Z1] = "TIR2" Then
        y = 418.25
    ElseIf [Z1] = "TIR3" Then
        y = 724.25
    End If
    With ActiveSheet
            .Paste
            For Each shp In ActiveSheet.Shapes
               If shp.Top = y Then
               i = i + 1
                S = shp.Left + shp.Width
               End If
            Next
            If S = 0 Then
                Selection.Top = y
                Selection.Left = 50
            Else

                Selection.Top = y
                Selection.Left = S
            End If
    End With
End Sub

Şekil Sayma

Sub SekilSay()
    For i = 82 To [b65536].End(3).Row
        c = 0
        k = 0
        j = 0
        For Each shp In ActiveSheet.Shapes
          If shp.TopLeftCell.Row < 27 Then
            If Cells(i, 2) = shp.Name Then
             c = c + 1: Cells(i, 5) = c
            End If
          End If
          If shp.TopLeftCell.Row > 32 And shp.BottomRightCell.Row < 53 Then
            If Cells(i, 2) = shp.Name Then
             k = k + 1: Cells(i, 6) = k
            End If
          End If
          If shp.TopLeftCell.Row > 55 Then
            If Cells(i, 2) = shp.Name Then
             j = j + 1: Cells(i, 7) = j
            End If
          End If
        Next
    Next
End Sub

 

[şiraz1]

harika oldu ellerine sağlık