Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2004 Salı

CommandBarControls Management




'Module1

Dim CBC As Office.CommandBarControl
Dim Rapor As String

Sub MenüKomutlarınıKapat()
On Error GoTo 0
Rapor = Empty
For Each CBC In Application.CommandBars.FindControls(Id:=847)
CBC.Enabled = False
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
For Each CBC In Application.CommandBars.FindControls(Id:=889)
CBC.Enabled = False
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
MsgBox "Kullanım DIŞINA alınan [CBC] Menü Komutları" & VBA.Chr(13) & Rapor & vbCrLf & VBA.Chr(13) & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] CommandBarControl Enabled/Disabled..."
End Sub
Sub MenüKomutlarınıAç()
On Error GoTo 0
Rapor = Empty
For Each CBC In Application.CommandBars.FindControls(Id:=847)
CBC.Enabled = True
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
For Each CBC In Application.CommandBars.FindControls(Id:=889)
CBC.Enabled = True
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
MsgBox "Kullanım İÇİNE alınan [CBC] Menü Komutları" & VBA.Chr(13) & Rapor & vbCrLf & VBA.Chr(13) & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] CommandBarControl Enabled/Disabled..."
End Sub

10 Temmuz 2004 Cumartesi

Enabled / Disable Cut And Paste


'Module1

Option Explicit
Dim CB As CommandBar
Dim CBC As CommandBarControl

Sub DisableCutAndPaste()
On Error GoTo 0
EnableControl 21, False 'Cut
EnableControl 19, False 'Copy
EnableControl 22, False 'Paste
EnableControl 755, False 'PasteSpecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub
Sub EnableCutAndPaste()
On Error GoTo 0
EnableControl 21, True 'Cut
EnableControl 19, True 'Copy
EnableControl 22, True 'Paste
EnableControl 755, True 'PasteSpecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
On Error Resume Next
For Each CB In Application.CommandBars
Set CBC = CB.FindControl(Id:=Id, Recursive:=True)
If Not CBC Is Nothing Then CBC.Enabled = Enabled
Next
End Sub

1 Temmuz 2004 Perşembe

Multi Sheet Print



'Module1

Option Explicit
Dim AktifOlan As Object, Sayfa, Sayfalar, SonResim As Object
Dim Yazdırılan As Worksheet
Dim Resimler As Integer

Sub Çoklu_Sayfa_Yazdırma()
On Error GoTo 0
Set Sayfalar = ActiveWindow.SelectedSheets
If Sayfalar.Count = 1 Then
Selection.PrintOut preview:=True
Exit Sub
End If
Set AktifOlan = ActiveSheet
Application.ScreenUpdating = False
AktifOlan.Select
Set Yazdırılan = Worksheets.Add
For Each Sayfa In Sayfalar
If TypeName(Sayfa) = "Worksheet" Then
Resimler = Resimler + 1
Sayfa.Activate
Selection.CopyPicture
Yazdırılan.Cells(Resimler * 3 - 2, 1).Value = Sayfa.Name
Yazdırılan.Paste Yazdırılan.Cells(Resimler * 3 - 1, 1)
Yazdırılan.Rows(Resimler * 3 - 1).RowHeight = Yazdırılan.Pictures(Resimler).Height
End If
Next Sayfa
Yazdırılan.PrintOut preview:=True
Application.DisplayAlerts = False
Yazdırılan.Delete
Application.DisplayAlerts = True
Sayfalar.Select
AktifOlan.Activate
Application.ScreenUpdating = True
End Sub

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul