Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: Hüseyin Çoban - 16 Aralık 2010, 21:01:17

Başlık: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Hüseyin Çoban - 16 Aralık 2010, 21:01:17

Merhaba Arkadaşlar,

Barkod yazdırmak için tablo yapmaya çalışıyorum.

Şöyle bir işleme ihtiyacım var. "barcode" dosyasında fontları kopyala butonunu tıkladığımda aynı dosya içerisindeki fontlar klasörünün içerisindeki dosyaları
C:\WINDOWS\Fonts    klasörünün içine kopyalamalı.


Yardım ve fikirlerinizi bekliyorum.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Bülent Öztürk - 17 Aralık 2010, 09:06:36

Merhaba Hüseyin Bey,

İşyerindeki bilgisayarda kısıtlı kullanıcı olduğum için çalıştıramadım, siz aşağıdaki 2 yöntemi dener misiniz?

Kod: [Seç]

Sub Düğme1_Tıklat()
'C:\WINDOWS\Fonts
bak = ThisWorkbook.Path & Application.PathSeparator & "FONTLAR"
With Application.FileSearch
    .NewSearch
    .LookIn = bak
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        For excelce = 1 To .FoundFiles.Count
            FileCopy .FoundFiles(excelce), "C:\WINDOWS\Fonts"
        Next excelce
    Else
        MsgBox "Dosya bulunamadı."
    End If
End With
MsgBox "İşlem tamam.", vbInformation, "Excelce.Net"
End Sub

Alıntı

Sub InstallFonts()
'http://www.edugeek.net/forums/scripts/4756-script-install-fonts-workstations.html
  On Error Resume Next
  Const FONTS = &H14
  Dim oFSO, oShell, oFolder1, oFolder2, sRoot
  sRoot = ThisWorkbook.Path & Application.PathSeparator & "FONTLAR"
  Set oShell = CreateObject("Shell.Application")
  Set oFSO = CreateObject("scripting.filesystemobject")
  Set oFolder1 = oShell.Namespace(FONTS)
  Set oFolder2 = oFSO.getfolder(sRoot)
  For Each oFile In oFolder2.Files
    sName = LCase(oFile.Name)
    If Right(sName, 4) = ".ttf" Then
      If Not oFSO.fileexists(oFolder1.self.Path & "\" & sName) Then
        oFolder1.CopyHere sRoot & sName
      End If
    End If
  Next
  On Error GoTo 0
End Sub

Bir de:
http://www.vb-helper.com/howto_install_font.html
http://www.visualbasicscript.com/Install-Windows-Fonts-m84489.aspx

Başlık: Ynt: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Hüseyin Çoban - 17 Aralık 2010, 19:31:29

Merhaba Bülent Bey,

İlk kodları tabloya uyguladım, ancak

Kod: [Seç]

With Application.FileSearchkodunda hata verdi. Sanırım Office 2007 kullandığım için. Alternatif olarak nasıl bir değişiklik yapabilirim?

Başlık: Ynt: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Bülent Öztürk - 19 Aralık 2010, 21:23:09

Merhaba Hüseyin Bey.

Haklısınız FileSearch, 2007 versiyonunda çalışmıyor.
Ancak sanırım sorun bu değil. Makro ile font yüklemenin farklı bir inceliği var zannedersem.
Birden fazla kod ile yöntem denedim ama font yüklemeyi başaramadım.

Microsoft dahil, çeşitli yabancı sitelerden bulduğum kodlarda ise sürekli "File not found: GDI" hatası aldım.  :(

Siz bir çözüm bulabildiniz mi?

Başlık: Ynt: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Hüseyin Çoban - 19 Aralık 2010, 21:42:18

Merhaba Bülent Bey,

İlginiz için çok teşekkür ederim.

Fonts kopyalama işlemi normal kopyala yapıştırmadan daha farklı.
Daha çözüm bulamadım. Bu işlemide normal yollardan kopyala-yapıştır diyerek yapalım artık.   :saygilar

Başlık: Ynt: Barkod oluşturmak için font kopyalama işlemi
Gönderen: Bülent Öztürk - 19 Aralık 2010, 21:44:27

Mutlaka bir çözümü olmalı aslında.
Olmaz diye bir şey olmaz ama sanırım gözden kaçırdığımız bir ayrıntı var...  :hımm