Posts by max_lux

Re: Protect / Unprotect Worksheets

To not allow any cells on a sheet to be selected add this to your protect/unprotect code:

ActiveSheet.EnableSelection = xlNoSelection

and this to the sheet object to suppress double click error messages:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

To allow selection of unprotected cells only

ActiveSheet.EnableSelection = xlUnlockedCells

Re: SendKeys TO Windows not Application

oh ok, sorry I misread what you wanted.

I'm racking my brains tryin to figure out a way you could do this. I'm sure Andy or Norie or Dave will have an answer. They do for everyhting else :grin: (lucky for us)

Re: SendKeys TO Windows not Application

make Excel invisible and ensure the app you want the keys sent to is the active window

application.visible=false
application.sendkeys("{SCROLLLOCK}")
application.wait (now +timevalue("00:00:01"))
application.sendkeys("{SCROLLLOCK}")
application.visible=true

I typed the above code so not sure if the syntax' are correct

Re: Dag & Drop listboxes

Screw Christmas. :gift: :yikes: Code that does things REALLY rocks! :rock:

Thanks Andy :grin:

Re: Dag & Drop listboxes

This is Access only? I'm going to set this up in Excel if possible, half way there, but form woulf have to be "List_Box_Example"

...apparently, hehe

DOH! Access Help

Re: Save as using windows tree

Even better, to open the dialog path to where the workbook resides

Dim CtDir As String
CtDir = Application.ActiveWorkbook.Path
If ActiveWorkbook.Saved = True Then
    Application.Quit
Else
    ChDir CtDir
    Application.Dialogs(xlDialogSaveAs).Show
    Application.Quit
End If

you can change this

CtDir = Application.ActiveWorkbook.Path

to this to save to the default save folder

CtDir = Application.DefaultFilePath

Re: Save as using windows tree

you could rewrite this so the saveas dialog only shows up if the file is not saved already

If Saved = True Then
    Application.Quit
Else
    Application.Dialogs(xlDialogFileSaveAs).Show
End If

Re: save as conflict

cancel = True

maybe

Re: Dag & Drop listboxes

One direction or both?

Just to be clear, I'm sorry but I don't have the time to do this for you at the present. I'm just clarifying your requirments, so if I get the time I could do this. Should someone else beat me to the punch, that would work too.

As I said, like in many win side by side listboxes, either arrow buttons or add/remove buttons or something similiar will have to be employed to do this. I can't see drag and drop doing it. I could be wrong, however. It wouldn't the first time...

Re: Dag & Drop listboxes

Quote

all items from one list will be moved to the second list.

is that what you want? or single items?

Re: Save as using windows tree

You must remember to use code tags...

[bp]*[/bp]

Please take more care in future.

This brings up the save as dialog

Application.Dialogs(xlDialogFileSaveAs).Show

Re: Dag & Drop listboxes

This would have to be done with buttons rather than as drag and drop

Re: Handling error

... edited - Andy answered this

Re: Application.display alerrts and visible=false

This works for me to save it without the prompt

tip: run the saved and close event in a sub inside Word for it to work. It won't work from Excel.

ActiveDocument.Saved = True
Application.Quit

and, I am thinking, you have the visible=false in the wrong place

try something like this (no guarantees, but better than what you have got so far)

Sub Unload4_Click() 
    Dim rngMine As Range 
    Dim rngMine2 As Range 
    Dim wdApp As Word.Application 
    Dim myDoc As Word.Document 
    Dim mywdRange As Word.Range 
    Dim TableTemp As Table 
    Dim rngTemp As Range 
    Dim Loseall As Range 
    Dim rngMine3 As Range 
    Dim wdApp3 As Word.Application 
    Dim myDoc3 As Word.Document 
    Dim mywdRange3 As Word.Range 
    Dim rngTemp3 As Range 
    Dim Loseall3 As Range 
     
    On Error Resume Next 
     
    Set wdApp3 = New Word.Application 
    Set myDoc3 = wdApp3.Documents.Add 
    Set mywdRange3 = myDoc3.Words(1) 
    Set rngMine3 = ThisWorkbook.Worksheets("Fax").Range("Offforword3") 
    Set wdApp = New Word.Application 
    Set myDoc = wdApp.Documents.Add 
    Set mywdRange = myDoc.Words(1) 
    Set rngMine = ThisWorkbook.Worksheets("Calc").Range("offforword") 
    Set rngMine2 = ThisWorkbook.Worksheets("dum").Range("offforword2") 
     
    wdApp3.Visible = False


    If ThisWorkbook.Worksheets("Calc").Range("a1001") = 0 Then 
        rngMine2.Copy 
    Else 
        rngMine.Copy 
    End If 
     
    With mywdRange 
        .PasteExcelTable False, False, False 
        .PageSetup.Orientation = wdOrientPortrait 
        .PageSetup.Gutter = 0# 
        .PageSetup.BottomMargin = 10 
        .PageSetup.LeftMargin = 15 
        .PageSetup.RightMargin = 10 
        .PageSetup.TopMargin = 10 
        .Application.DisplayAlerts = wdAlertsNone 
        myDoc.Saved = True 
        Set TableTemp = wdApp.ActiveDocument.Tables(1) 
    End With 
    Application.ScreenUpdating = True 
     
    With wdApp 
        .Application.DisplayAlerts = wdAlertsNone 
        myDoc.PrintOut 
        .Visible = False 
        myDoc.Saved = True 
        myDoc.Close 
        wdApp.Quit 
    End With 
     
    With wdApp3 
        .DisplayAlerts = wdAlertsNone 
        .Visible = False 
    End With 
    Application.ScreenUpdating = False 
    If ThisWorkbook.Worksheets("Calc").Range("a1001") > 0 Then 
         
        Set rngMine3 = ThisWorkbook.Worksheets("Fax").Range("Offforword3") 
        rngMine3.Copy 
        With mywdRange3 
            .PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement _ 
            :=wdInLine, DisplayAsIcon:=False 
             
            .PageSetup.Orientation = wdOrientPortrait 
            .PageSetup.Gutter = 0# 
            .PageSetup.BottomMargin = 10 
            .PageSetup.LeftMargin = 10 
            .PageSetup.RightMargin = 15 
            .PageSetup.TopMargin = 10 
            .Application.DisplayAlerts = wdAlertsNone 
        End With 
        Application.ScreenUpdating = True 
         
        With wdApp3.Visible = False 
            .Application.DisplayAlerts = wdAlertsNone 
            .Application.DisplayAlerts = False 
            myDoc3.PrintOut 
        End With 
    End If 
    Set wdApp3 = Nothing 
    Set myDoc3 = Nothing 
    Set mywdRange3 = Nothing 
    Set rngMine3 = Nothing 
    Set wdApp = Nothing 
    Set myDoc = Nothing 
    Set mywdRange = Nothing 
    Set rngMine = Nothing 
    Set TableTemp = Nothing 
    Set rngTemp = Nothing 
End Sub

Re: Run Word Macro From Excel

I can use whatever you suggest, because I know it will work!

I tried:

AppWd.Run "Clean"
AppWd.Application.Run "Clean"
AppWd.Call Clean
AppWd.Macros.Clean
AppWd.Macros "Clean"

...as well as about 50 other variations on that theme, but none did the trick, which is why I asked.

Thanks Norie

Explanation
I have a textbox in Excel with text containing abbreviations.
I copy the text in the textbox to the clipboard.
I open Word.
I paste the text to Word (specific pre-made file)
At this point I would like to run a macro in word to change the abbreviations to the full words (macro is made in Word specific file already- It is in module called "Macros", and the sub is called "clean"
I select and copy the text to the clipboard.
I close Word
I paste the text back into the textbox in Excel.

I can't get a macro to run. Have tried numerous variations. Is it possible? Here is my code:

Private Sub CleanText_Click()
Dim MyData
    If sheet1.TextBox1.Value = "" Then
        Exit Sub
    ElseIf sheet1.TextBox1.Value > "" Then
        With sheet1.TextBox1
            .Activate
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
        Set MyData = New DataObject
        MyData.SetText TextBox1.Text
        MyData.PutInClipboard
    End If
    Dim appWd As Object
    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    appWd.Visible = xlMaximized
    ChDir "C:\CAM\"
    appWd.Documents.Open FileName:="C:\CAM\TextCleaner.doc"
    MyData.GetFromClipboard
    appWd.Selection.Paste
    
    appWd.                     'Need macro run code here


    appWd.Selection.WholeStory
    appWd.Selection.Copy
    appWd.DisplayAlerts = False
    appWd.Application.Quit
    Set MyData = New DataObject
    MyData.GetFromClipboard
    sheet1.TextBox1.Text = MyData.GetText
    
End Sub

Thanks in advance!

Re: Stopping warning messages

I'm sorry my friend but I know of nothing that disables that warning. If there were, I would be using it myself... I'm not a fan of that warning either.

Re: Stopping warning messages

Application.DisplayAlerts = False

dont forget to turn it back on with true

...doesn't disable protection message. I'm not sure if that is possible...

Re: Change Sheet TAB Color

I was thinking abbeville wanted this as a workbook event - me bad

Private Sub Worksheet_Deactivate()
    Sheet1.Tab.ColorIndex = 3
End Sub

works as a specific sheet event

Andy to the rescue

oh, to be more specific, you find the "actual" sheet name in the VBA editor.

It is listed like

Sheet1(Sheet1) where the word outside the brackets is the actual name, and the word inside is what the tab says

Re: Change Sheet TAB Color

sorry that won't work either - it only works on the physical "previous" (on in front of the one you are on) sheet, not the "last" sheet you had active.

I'm going to continue to look for a solution...