DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub cetvel_inch() |
'Define the size of a new ruler. |
Const Ruler_Width As Double = 6 'Width 6 inch |
Const Ruler_Height As Double = 5 'Height 5 inch |
'The setting size on the screen and the actual size on the printer. |
Const Screen_Width As Double = 6 |
Const Screen_Height As Double = 5 |
Const Printer_Width As Double = 6 |
Const Printer_Height As Double = 5 |
Dim i As Long |
Dim l As Double |
Dim x As Long |
Dim y As Long |
Dim ws As Worksheet |
Dim a(0 To 15) As Double |
Dim x2 As Double |
Dim y2 As Double |
x = Ruler_Width * 16 |
y = Ruler_Height * 16 |
a(0) = 3.6: a(1) = 1: a(2) = 2: a(3) = 1: a(4) = 2: a(5) = 1: a(6) = 2: a(7) = 1 |
a(8) = 3: a(9) = 1: a(10) = 2: a(11) = 1: a(12) = 2: a(13) = 1: a(14) = 2: a(15) = 1 |
Application.ScreenUpdating = False |
Set ws = ActiveSheet |
Worksheets.Add |
ActiveSheet.Move |
ActiveSheet.Lines.Add 0, 0, 3 * x, 0 |
For i = 1 To x |
l = a(i Mod 16) |
ActiveSheet.Lines.Add 3 * i, 0, 3 * i, 3 * l |
Next |
ActiveSheet.Lines.Add 0, 0, 0, 3 * y |
For i = 1 To y |
l = a(i Mod 16) |
ActiveSheet.Lines.Add 0, 3 * i, 3 * l, 3 * i |
Next |
ActiveSheet.Lines.Border.ColorIndex = 55 |
For i = 16 To x - 1 Step 16 |
With ActiveSheet.TextBoxes.Add(3 * i - 9, 3 * 3.6, 18, 12) |
.Text = Format(i \ 16, "!@@") |
End With |
Next |
For i = 16 To y - 1 Step 16 |
With ActiveSheet.TextBoxes.Add(3 * 3.6, 3 * i - 9, 12, 18) |
.Orientation = xlDownward |
.Text = Format(i \ 16, "!@@") |
End With |
Next |
With ActiveSheet.TextBoxes |
.Font.Size = 9 |
.Font.ColorIndex = 55 |
.HorizontalAlignment = xlCenter |
.VerticalAlignment = xlCenter |
.Border.ColorIndex = xlNone |
.Interior.ColorIndex = xlNone |
End With |
With ActiveSheet.DrawingObjects.Group |
.Placement = xlFreeFloating |
.Width = Application.InchesToPoints(x / 16) |
.Height = Application.InchesToPoints(y / 16) |
.CopyPicture xlScreen, xlPicture |
ActiveSheet.Paste |
x2 = (Selection.Width - .Width) / 3 |
y2 = (Selection.Height - .Height) / 3 |
Selection.Delete |
.CopyPicture xlPrinter, xlPicture |
ActiveSheet.Paste |
.Width = .Width * .Width / (Selection.Width - x2 * 2) * Screen_Width / Printer_Width |
.Height = .Height * .Height / (Selection.Height - y2 * 2) * Screen_Height / Printer_Height |
Selection.Delete |
If Val(Application.Version) >= 9 Then |
.Copy |
ActiveSheet.PasteSpecial 'Format:="Picture (PNG)" |
With Selection.ShapeRange.PictureFormat |
.CropLeft = x2 |
.CropTop = y2 |
.CropRight = x2 |
.CropBottom = y2 |
End With |
Selection.Copy |
ws.Activate |
ws.PasteSpecial 'Format:="Picture (PNG)" |
Selection.Placement = xlFreeFloating |
.Parent.Parent.Close False |
End If |
End With |
Application.ScreenUpdating = True |
End Sub |
Teşekkürler işe yaradı ama excel i pdf ye çevirince yine ölçülendirmedeki oklarda sapmalar olduNesneyi sağ tıklatın "Resim Biçimlendir" seçin.
Kırp kısmından istediğiniz kadar kırpabilirsiniz.
Ekli dosyayı görüntüle 235440
Bilgileriniz için teşekkürler ≤ yada ≥ karakterlerinin ? olarak görünmesi hariç sorunları çözdüm benMerhaba,
Örnek olarak gönderdiğiniz dosyayı sistemimde bulunana AutoCAD 2017 ile açmaya çalıştığımda hata veriyor, söz konusu örnek dosyanızı 2017 veya öncesi için kaydedip paylaşabilirseniz nasıl daha net bir görüntü alabilmeniz için inceleyebilirim.
Nesne içine Autocad çiziminizi eklediğinizde zemin beyaz çıkar, Çözüm: Nesne üzerinde sağ tuş > Nesne Biçimlendir > Renk ve Çizgiler sekmesine gelip dolgu ve çizgiyi YOK edebilirsiniz. (Nesne alanı değişmez) *Bu alanı küçültmek için kırp kullanabilirsiniz.
Nesneyi Ekle dediğinizde Autocad açılır, *Nesne Autocad pencerenize göre boyutlanır. Excel'e almak istediğiniz Çizim yada Tablonuzun boyutunu değiştirmeden Autocad pencerenizi sadece bu alan kalacak şekilde boyutlandırın. ve kaydedin: Nesnenizin artık pencere boyutlarına geldiğini göreceksiniz dolayısı ile bir nevi kırpma işlemi yapmış olacaksınız.
*Esnemelerden kaynaklanan bir bozulma olmaması için çalışmanıza bir kare ekleyin ve kaydedin, excel üzerinde yine bir kare ekleyin (Geçirgen yapıp) bunu referans alarak çiziminizde yer alan kare üzerine doğru şekilde yerleştirdikten sonra boyutlandırmanızı Köşelerden yapınız. *Bu işlemi zoom yaptıktan sonra çalışmanızdan bu kareyi silebilirsiniz.
Yaptığım denemede ≤ yada ≥karakterini aktarırken bende de ? olarak görünüyor. Autocad de kullanılan yazı karakteri ile alakalı olmadığını gözlemledim.
Ya da daha net bir görüntü almak için Projenizi harici programlar ile Vektörel hale getirip dilediğiniz gibi bozulma olmadan dosyalarınızda kullanabilirsiniz.
İyi çalışmalar.