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
-
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.]
-
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?
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
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
-
Merhaba Bülent Bey,
İlk kodları tabloya uyguladım, ancak
With Application.FileSearch
kodunda hata verdi. Sanırım Office 2007 kullandığım için. Alternatif olarak nasıl bir değişiklik yapabilirim?
-
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?
-
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
-
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