Posts by Jack in the UK

Something I played around with years and years ago - kind of got it working, sorry I can not locate the xls I have all the testing in

jiuk

Option Explicit


Const VK_VOLUME_MUTE = &HAD
Const VK_VOLUME_DOWN = &HAE
Const VK_VOLUME_UP = &HAF


#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If


Sub My_Turn_The_Volume_UP()
Call Turn_The_Volume_UP
End Sub


Sub My_Turn_The_VOLUME_DOWN()
Call Turn_The_Volume_DOWN
End Sub


Sub myVOLUME_MUTE()
Call Volume_MUTE
End Sub


Sub Turn_The_Volume_UP()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub


Sub Turn_The_Volume_DOWN()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub


Sub Volume_MUTE()
keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub

Quote from jerry12302.1

I have code that opens adobe files, copies their content, and pastes it into a range in Excel. It works OK, but as it cycles through the Adobe files, one at a time, every time it minimizes the Adobe window to get back to Excel, during:

SendKeys ("%n"), True

it beeps. (I've isolated this portion of the macro through trial and error, this is the code that triggers the beep) This gets annoying when there are several files to load.

Is there some VBA code to turn off the audible beep sound during a macro? Or another way to set the focus back to Excel so the data can be pasted, instead of minimizing the Adobe window?

I don't want to turn down the volume, in case there are other non-related alerts or notifications that need attention afterward.

Respectfully,

Jerry

"An infinite number of me would never type Shakespeare; Douglas Adams, maybe..."

Display More

This gets a little complicated, the send keys here

SendKeys ("%n"), True

Use to close Adobe, or minimize (something like that), not sure why this code causes a bleep sound

Can you double check this is correct

jiuk

Try this code and see if it behaves, if so the find is big criteria, generally I hit one unique word

Try find subsidies only

Option Explicit

Sub a()

' replace the comment
' With Selection.find
Dim myTEXT As String
Dim myReplacementTEXT As String

myTEXT = "Government subsidies that are included in the current profit and loss, but are closely related to the company's normal business operations, except for government subsidies that meet national policy requirements and are continuously enjoyed by a fixed amount or amount according to a certain standard"
myReplacementTEXT = "Government subsidy accounted as gain or loss for the period, other than those closely related to the company's normal business operations, complying with the national policy, and continuing to be enjoyed at a fixed rate or amount"
' End With
' Selection.find.Execute Replace:=wdReplaceAll

MsgBox myTEXT
MsgBox myReplacementTEXT

End Sub

jiuk

Hi JackWhittaker, welcome to OzGrid good to have you along

Just a quick one can you change the subject title to something more meaningful that reflects your question, help the member a lot more and you getting help

Also please read the forum rules, you will see a link in my sign, many thanks in advance

jiuk

Also:

Duplicate of closed post

ozgrid.com/forum/index.php?thr…r-based-on-the-list-give/

Please take time to read the forum rules, they are there to assist and help all members

jiuk

You need to untick the checkbox at the end of its use line 19 is the check and code is to line 26

So many add a forced change statement to change the checkbox value = FALSE

UserForm1.CheckBox1.Value = False

This code you can play and test before adding to your work, test on a separate spreadsheet first

If UserForm1.CheckBox1.Value = True Then
       MsgBox "Checked", , "Jack in the UK"
    Else
       MsgBox " UnChecked", , "Jack in the UK"
    End If

UserForm1.CheckBox1.Value = False

jiuk

No problems Sir, thank you for letting us all know, glad the codes work ok

Please note, as has been mentioned, use with cautions as users can hate thinks that flash etc.... a couple of runs should be fine, good luck

jiuk

This should cover what you want, again test in a copy of your work or a new spreadsheet just in case

This gives the best of 'all' worrlds. Not the greatest code but should be robust and work ok

jiuk

'// jiuk
Const myStart_NUMBER As Long = 1
Const myEND_NUMBER As Long = 3

Private Sub JACKS_Delay(ms As Long)
Application.Wait (Now + (ms * 0.00000001))
End Sub

Private Sub Box_FLASH()

Dim i As Long

For i = 1 To 2 Step 1

'// jiuk - change TextBox_FILL to RED
TextBox1.BackColor = RGB(0, 128, 64)
Me.Repaint
Call JACKS_Delay(1000)
'// jiuk - Delay set to 1 second = 2000

'// jiuk - change TextBox_FILL to Green
TextBox1.BackColor = RGB(255, 0, 0)
Me.Repaint
Call JACKS_Delay(1000)

'// jiuk - change TextBox_FILL Yellow
TextBox1.BackColor = RGB(255, 255, 0)
Me.Repaint
Call JACKS_Delay(1000)

Next i
 
theEND:
'// jiuk - do something
'// jiuk - can be REM or deleted, messsage to confirm done
MsgBox "done"
Exit Sub

End Sub

Private Sub CommandButton1_Click()
Me.Repaint
Call Box_FLASH
End Sub

Private Sub UserForm_Activate()
'Me.Repaint
Call Box_FLASH
End Sub

Private Sub UserForm_Click()
'// jiuk - NA
End Sub

This sould more or less do what you want, maybe test on a copy of your work forst and add this code to the UserForm module code, add a command button1

Private Sub CommandButton1_Click()

Dim i As Long

For i = 1 To 3 Step 1

'// jiuk - change TextBox_FILL to RED
TextBox1.BackColor = RGB(0, 128, 64)

'// jiuk - Delay 1 second
Application.Wait (Now + TimeValue("0:00:1"))

'// jiuk - change TextBox_FILL to Green
TextBox1.BackColor = RGB(255, 0, 0)

'// jiuk - Delay 1 second
Application.Wait (Now + TimeValue("0:00:1"))

'// jiuk - change TextBox_FILL Yellow
TextBox1.BackColor = RGB(255, 255, 0)

'// jiuk - Delay 1 second
Application.Wait (Now + TimeValue("0:00:1"))

Next i
 
theEND:
'// - do something
'// jiuk - can be REM or deleted, messsage to confirm done
MsgBox "done"
Exit Sub

End Sub

Close ‘only’ the VBA Editor and re-open it using Alt + F11 Key
See if the issues is correct or not.

If this issue persists:
Save the Workbook
Close the Workbook
Re-open open the workbook
Check in the VBA Editor if things are corrected or not

Maybe a workbook re-name failed and not updated in VBA Editor

If the issues also persists:
Make a copy of the data of that sheet and paste on a new sheet. This will be same for any codes, remember to copy to the same places

Re-name that problematic sheet as …. OLD and rename the new sheet as old one was

jiuk

If you use this code to a Command Button, things should work

Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


    msgbox "Jack your double clicked Command Button 1"


End Sub

Now if you want to derail single click of Command Button, just don’t have any code assigned to single click and nothing will happen or for better coding try

Private Sub CommandButton1_Click()


    ‘// jiuk – do nothing


Exit sub


End Sub

Jiuk

These sorts of codes are great as backups, were all guilty on not saving enough

This is save the active workbook, assumes already named and saved, and really only replaces using CTRL+S keys pressed together on the keyboard

Admitted there are in this code as is common parameters to that save, thou again that exposes rick

Learn to use CTRL+S always and as you work, no matter what safety measures you have in place

Just a point, nothing more

jiuk

Quote from Justin Doward

Just found that if you insert

Code

On Error Resume Next 

in the code for each of the UDFs I think it fixes the problem if same values are found.

option explicit is not set as noted in the code - could cause an issue or two as things not declared fully/correctly

Make sure you correctly turn on error back 'on', what that code does is ignore errors

jiuk

Very true Roy - I have spreadsheets at work again now so it’s a must or be there all day to be honest, most is data cleaning and converting

I use XLSB a lot and call what I want, it’s all a bit messy in there, but works and I add edit as I go

jiuk

Thats for letting everyone know things are working - sorry I changed the attachment to textbox should should be OK to try

roy blimey, hardly coded in 10 years,hardly remember a thing except the concepts and what's required, the doing another issue

jiuk

No problem, I would use Fluff code it is a lot less work and easy enough to edit if required

jiuk

A little bit fuller code, sorry Jack had to write this one up for you

jiuk

Option Explicit

Sub myWIDTH()
'** . Columns("C").ColumnWidth=Sheet2!A1 without success.

Dim myColumn As Long
myColumn = 3 ' i.e. Column C

Dim myWidth_VALUE
myWidth_VALUE = Sheets("Sheet2").Range("A1").Value

With Columns("C")
    .ColumnWidth = myWidth_VALUE
    
End With

theEND:
' jiuk - do something
Exit Sub

End Sub

Something very crude, thou should get thing moving the right way, see attachmentforum.ozgrid.com/index.php?attachment/1227421/

Code is:

jiukOzGrid Dates in Form post1232182.xlsm

If you add this code into a standard VBA module and run things will work as you want, this is not part of the spreadsheet attached

Add a command button, copy the code to a module, attach the code macro to the command button and save

Run the code. If you stuck on any part of this, please have try and post back for assistance, be happy to help

Jack has added a message box to show the output as you require

If you want to have text boxes and run the codes once input your need trigger and a far bit of validation codes - maybe the best approach is to have a second form and rebuild from there step by step, the code works so it is useable, thou will need re-jigging quite a bit

jiuk

Sub ageCalculator()
Dim age As Integer, dob As Date, dt As Date
dob = InputBox("Enter Date of Birth")
dt = InputBox("Enter <age on> date")
years = IIf(dt > DateSerial(Year(dt), Month(dob), Day(dob)), DateDiff("yyyy", dob, dt), DateDiff("yyyy", dob, dt) - 1)
months = IIf(Day(dt) > Day(dob), Abs(Month(dob) - Month(dt)), Abs(Month(dob) - Month(dt)) - 1)
Days = IIf(Day(dt) > Day(dob), Day(dt) - Day(dob), (Day(DateSerial(Year(dob), Month(dob) + 1, 1) - 1) - Day(dob)) + Day(dt))
Debug.Print years & "years " & months & "months" & Days & "days"

' jiuk - added to see output without debug.print
'MsgBox years & "years " & months & "months" & Days & "days"

'// **
'// jiuk - maybe change to

MsgBox years & " Years " & vbCrLf & months & " Months " & vbCrLf & Days & " Days "

End Sub

Hey Roy, good to have given the code the once over 35 lines to 25, thank you

That’s was some old code Jack wrote from nearly 15 years back. Jack hardly codes at all nowadays and has not for many years, so the style is just the same!

jiuk