|
I guess you must search[^] for the solution to this one 
|
|
|
|
|
Hi,
I'm relative new in vb.net programming, so I have some questions about printer settings, printer properties.
How could I share a local printer? Also I would like to access another PC and share a printer installed on that computer. How could I do that?
I used the following vbscript code, but I can't convert it to vb.net:
strComputer = "w20hy050"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer Where Name = 'Customer'")
For Each objPrinter in colInstalledPrinters
objPrinter.Shared = TRUE
objPrinter.ShareName = "Customer"
objPrinter.Put_
Next
Thanks for your help.
modified 5-Apr-13 11:32am.
|
|
|
|
|
Robert Kadar wrote: I can't convert it to vb.net:
There's a Proces class that you can use to launch your vb-script.
Robert Kadar wrote: Also I would like to access another PC and share a printer installed on that computer. How could I do that?
You'd probably need local admin-rights on that computer.
Bastard Programmer from Hell 
If you can't read my code, try converting it here[^]
|
|
|
|
|
That script uses WMI. WMI can also be used in .Net programs.
|
|
|
|
|
Sir,
I have created this program and it works perfect.
' Created by SharpDevelop.
' User: Zubair Khalid
' Date: 4/5/2013
' Time: 10:56 AM
'
' To change this template use Tools | Options | Coding | Edit Standard Headers.
'
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Windows.Forms
Imports System.IO
Imports System.Security.AccessControl
Public Partial Class MainForm
Public Sub New()
' The Me.InitializeComponent call is required for Windows Forms designer support.
Me.InitializeComponent()
'
' TODO : Add constructor code after InitializeComponents
'
End Sub
Sub Fldrbrws2Click(sender As Object, e As EventArgs)
If True Then
If folderBrowserDialog1.ShowDialog() = DialogResult.OK Then
fldrpath2.Text = folderBrowserDialog1.SelectedPath
End If
End If
End Sub
Sub Fldrlock2Click(sender As Object, e As EventArgs)
Try
Dim folderPath As String = fldrpath2.Text
Dim adminUserName As String = Environment.UserName
' getting your adminUserName
Dim ds As DirectorySecurity = Directory.GetAccessControl(folderPath)
Dim fsa As New FileSystemAccessRule(adminUserName, FileSystemRights.FullControl, AccessControlType.Deny)
ds.AddAccessRule(fsa)
Directory.SetAccessControl(folderPath, ds)
MessageBox.Show("Locked")
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Sub Fldrunlock2Click(sender As Object, e As EventArgs)
Try
Dim folderPath As String = fldrpath2.Text
Dim adminUserName As String = Environment.UserName
' getting your adminUserName
Dim ds As DirectorySecurity = Directory.GetAccessControl(folderPath)
Dim fsa As New FileSystemAccessRule(adminUserName, FileSystemRights.FullControl, AccessControlType.Deny)
ds.RemoveAccessRule(fsa)
Directory.SetAccessControl(folderPath, ds)
MessageBox.Show("UnLocked")
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Sub MainFormLoad(sender As Object, e As EventArgs)
Dim form As New Form1
form.ShowDialog
End Sub
End Class
But When I embed this code in my another project (converted from C# to VB.NET, All other functions work well) it does not works. Only browsing (fldrbrws2) button and lock (fldrlock2) button work perfectly but Unlock button (fldrunlock2) does not work perfectly. Its shows that it has unlocked but it does not.
here is my another project (in which i want to embed):
Imports System.ComponentModel
Imports System.Data
Imports System.Text
Imports System.Xml
Imports System
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Windows.Forms
Imports System.IO
Imports System.Security.AccessControl
Public Partial Class Form1
Inherits Form
Public status As String
'bool flag = true;
Private arr As String()
Private _pathkey As String
Public Sub New()
InitializeComponent()
arr = New String(5) {}
status = ""
arr(0) = ".{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}"
arr(1) = ".{21EC2020-3AEA-1069-A2DD-08002B30309D}"
arr(2) = ".{2559a1f4-21d7-11d4-bdaf-00c04f60b9f0}"
arr(3) = ".{645FF040-5081-101B-9F08-00AA002F954E}"
arr(4) = ".{2559a1f1-21d7-11d4-bdaf-00c04f60b9f0}"
arr(5) = ".{7007ACC7-3202-11D1-AAD2-00805FC1270E}"
End Sub
Public Property pathkey() As String
Get
Return _pathkey
End Get
Set
_pathkey = value
End Set
End Property
Private Sub button1_Click(sender As Object, e As EventArgs)
On Error Resume Next
status = arr(0)
'If folderBrowserDialog1.ShowDialog() = DialogResult.OK Then
Dim d As New DirectoryInfo(fldrpath1.Text)
Dim selectedpath As String = d.Parent.FullName & d.Name
If fldrpath1.Text.LastIndexOf(".{") = -1 Then
If checkBox1.Checked Then
setpassword(fldrpath1.Text)
End If
If Not d.Root.Equals(d.Parent.FullName) Then
d.MoveTo(d.Parent.FullName & "\" & d.Name & status)
Else
d.MoveTo(d.Parent.FullName & d.Name & status)
fldrst1.Text ="Locked (Password Protected)"
End If
fldrpath1.Text = folderBrowserDialog1.SelectedPath
'pictureBox1.Image = Image.FromFile(Application.StartupPath & "\lock.jpg")
fldrst1.Text = "Locked"
Else
status = getstatus(status)
Dim s As Boolean = checkpassword()
If s Then
File.Delete(folderBrowserDialog1.SelectedPath & "\p.xml")
d.MoveTo(folderBrowserDialog1.SelectedPath.Substring(0, folderBrowserDialog1.SelectedPath.LastIndexOf(".")))
fldrpath1.Text = folderBrowserDialog1.SelectedPath.Substring(0, folderBrowserDialog1.SelectedPath.LastIndexOf("."))
'pictureBox1.Image = Image.FromFile(Application.StartupPath & "\unlock.jpg")
fldrst1.Text = "Unocked"
End If
End If
'End If
fldrlock1.Enabled = False
fldrpath1.Text = ""
End Sub
Private Function checkpassword() As Boolean
Dim read As XmlTextReader
If pathkey Is Nothing Then
read = New XmlTextReader(folderBrowserDialog1.SelectedPath & "\p.xml")
Else
read = New XmlTextReader(pathkey & "\p.xml")
End If
If read.ReadState = ReadState.[Error] Then
Return True
Else
Try
While read.Read()
If read.NodeType = XmlNodeType.Text Then
Dim c As New checkpassword()
c.pass = read.Value
If c.ShowDialog() = DialogResult.OK Then
read.Close()
Return c.status
End If
End If
End While
Catch
Return True
End Try
End If
read.Close()
Return False
End Function
Private Function setpassword(path As String) As [Boolean]
On Error Resume Next
Dim p As New password()
p.path = path
p.ShowDialog()
Return True
End Function
Private Function getstatus(stat As String) As String
On Error Resume Next
For i As Integer = 0 To 5
If stat.LastIndexOf(arr(i)) <> -1 Then
stat = stat.Substring(stat.LastIndexOf("."))
End If
Next
Return stat
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs)
On Error Resume Next
Dim os As New os
os.ShowDialog
If Me.pathkey IsNot Nothing Then
Dim d As New DirectoryInfo(pathkey)
Dim selectedpath As String = d.Parent.FullName & d.Name
If pathkey.LastIndexOf(".{") = -1 Then
fldrpath1.Text = pathkey
Dim r As DialogResult
r = MessageBox.Show("Do You want to set password ? ", "Question?", MessageBoxButtons.YesNo)
If r = DialogResult.Yes Then
setpassword(pathkey)
End If
status = arr(0)
If Not d.Root.Equals(d.Parent.FullName) Then
d.MoveTo(d.Parent.FullName & "\" & d.Name & status)
Else
d.MoveTo(d.Parent.FullName & d.Name & status)
End If
'pictureBox1.Image = Image.FromFile(Application.StartupPath & "\lock.jpg")
Else
status = getstatus(status)
Dim s As Boolean = checkpassword()
If s Then
File.Delete(pathkey & "\p.xml")
d.MoveTo(pathkey.Substring(0, pathkey.LastIndexOf(".")))
fldrpath1.Text = pathkey.Substring(0, pathkey.LastIndexOf("."))
'pictureBox1.Image = Image.FromFile(Application.StartupPath & "\unlock.jpg")
End If
End If
End If
End Sub
Sub Button2Click(sender As Object, e As EventArgs)
On Error Resume Next
status = arr(0)
'If folderBrowserDialog1.ShowDialog() = DialogResult.OK Then
Dim d As New DirectoryInfo(fldrpath1.Text)
Dim selectedpath As String = d.Parent.FullName & d.Name
status = getstatus(status)
Dim s As Boolean = checkpassword()
If s Then
File.Delete(fldrpath1.Text & "\p.xml")
d.MoveTo(fldrpath1.Text.Substring(0, fldrpath1.Text.LastIndexOf(".")))
fldrpath1.Text = fldrpath1.Text.Substring(0, fldrpath1.Text.LastIndexOf("."))
'pictureBox1.Image = Image.FromFile(Application.StartupPath & "\unlock.jpg")
fldrlock1.Enabled = True
fldrpath1.Text = ""
fldrst1.Text ="Unocked"
End If
'End If
End Sub
Sub Button3Click(sender As Object, e As EventArgs)
On Error Resume Next
If folderBrowserDialog1.ShowDialog() = DialogResult.OK Then
Dim d As New DirectoryInfo(folderBrowserDialog1.SelectedPath)
Dim selectedpath As String = d.Parent.FullName & d.Name
fldrpath1.Text = folderBrowserDialog1.SelectedPath
fldrlock1.Enabled = True
End if
End Sub
Sub Fldrbrws2Click(sender As Object, e As EventArgs)
On Error Resume Next
If folderBrowserDialog2.ShowDialog() = DialogResult.OK Then
fldrpath2.Text = folderBrowserDialog2.SelectedPath
End If
End Sub
Sub Fldrlock2Click(sender As Object, e As EventArgs)
Try
Dim folderPath As String = fldrpath2.Text
Dim adminUserName As String = Environment.UserName' getting your adminUserName
Dim ds As DirectorySecurity = Directory.GetAccessControl(folderPath)
Dim fsa As New FileSystemAccessRule(adminUserName, FileSystemRights.FullControl, AccessControlType.Deny)
ds.AddAccessRule(fsa)
Directory.SetAccessControl(folderPath, ds)
fldrst3.Text = "Locked"
fldrpath2.Text = ""
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Sub Fldrunlock2Click(sender As Object, e As EventArgs)
Try
Dim folderPath As String = fldrpath2.Text
Dim adminUserName As String = Environment.UserName
' getting your adminUserName
Dim ds As DirectorySecurity = Directory.GetAccessControl(folderPath)
Dim fsa As New FileSystemAccessRule(adminUserName, FileSystemRights.FullControl, AccessControlType.Deny)
ds.AddAccessRule(fsa)
Directory.SetAccessControl(folderPath, ds)
fldrst3.Text = "Unlocked"
fldrpath2.Text = ""
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
End Class
|
|
|
|
|
I am not going to review your code; I am going to make suggestions.
Have you tried to debug the code to determine where the problem is?
What actions have YOU taken to determine what is happening?
|
|
|
|
|
Zubair Khalid wrote: I have created this program and it works perfect.
Cool.
Zubair Khalid wrote: But When I embed this code in my another project (converted from C# to VB.NET, All other functions work well) it does not works.
C# and VB.NET are both translated to IL. If converting it breaks it, then don't convert it. You can reference the code from any .NET language, as long as you have a compiled assembly.
Bastard Programmer from Hell
If you can't read my code, try converting it here[^]
|
|
|
|
|
Ok now you are just trying to confuse things with compiled assembly.
Never underestimate the power of human stupidity
RAH
|
|
|
|
|
One could also reference a project that has not been built. To keep things simple, I decided to not mention the not-yet-compiled-assembly option
Bastard Programmer from Hell
If you can't read my code, try converting it here[^]
|
|
|
|
|
I am getting this Error:
Quote: Index was out of range. Must be non-negative and less than the size of the collection.
I have two winforms, and i am trying to pass data between them
Form1 has Gridview which binds to a Store procedure that selects 8 parameters from a "Guardian Table".
form2 has 8 textboxes that I want the data from Form 1 to be displayed
what I want to do is by clicking "LookUp" Button (On FORM2) to get to FORM1 and get the selected row data (when the user selects one row) and display it on form 2
Now here is my code for both forms:
Public Sub getChangesFromForm2(ByVal text1 As String, ByVal text2 As String, ByVal text3 As String, ByVal text4 As String, ByVal text5 As String, ByVal text6 As String, ByVal text7 As String, ByVal text8 As String)
DataGridView1.SelectedRows(0).Cells(0).Value = text1
DataGridView1.SelectedRows(0).Cells(1).Value = text2
DataGridView1.SelectedRows(0).Cells(2).Value = text3
DataGridView1.SelectedRows(0).Cells(3).Value = text4
DataGridView1.SelectedRows(0).Cells(4).Value = text5
DataGridView1.SelectedRows(0).Cells(5).Value = text6
DataGridView1.SelectedRows(0).Cells(6).Value = text7
DataGridView1.SelectedRows(0).Cells(7).Value = text8
End Sub
FORM 2:
Private Sub LookUpBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LookUpBtn.Click
GuardianBasicList.getChangesFromForm2(GuardianIDTxt.Text, GuardianPhoneTxt.Text, GuardianFNameTxt.Text, GuardianMNameTxt.Text, GuardianLNameTxt.Text, GuardianEmergContFNameTxt.Text, GuardianEmergContLNameTxt.Text, GuardianEmergContPhoneTxt.Text)
GuardianBasicList.Show()
End Sub
What am I doing wrong? is there another way of achieving the same result??
ANY HELP given is highly appreciated.
Thank you
|
|
|
|
|
VB.Net is not my strong suit, But You should be passing the info as a class in your form2 constructor. Then just assign the data to the text boxes.
Hope this helps
Frazzle the name say's it all
Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live.
John F. Woods
|
|
|
|
|
Hello, i need to search an a code on an excel file then look for a file with that code and then replace name with another column in the excel file..
example:
CODE NAME
123 ABC
456 AB1
789 AB2
012 AB3
so get first code, look it up on a file list. then get name and rename file withe name...
|
|
|
|
|
|
What have you done so far? Where are you stuck?
Do you want to do that with VBA, VB.NET, C#, any???
|
|
|
|
|
VBA for Excel. Data stored in Sheet1, columns: A - CODE, B - NAME. Searches for files in the same folder in which is stored workbook.
Option Explicit
Sub ChangeTheNamesOfFiles()
Dim wsh As Worksheet
Dim sInitialPath As String, sOldName As String, sNewName As String, sExt As String
Dim i As Integer
sInitialPath = ThisWorkbook.Path & "\"
sExt = ".txt"
Set wsh = ThisWorkbook.Worksheets(1)
i = 2
Do While wsh.Range("A" & i)
sOldName = wsh.Range("A" & i)
sOldName = FindFile(sInitialPath, sOldName, sExt)
sNewName = sInitialPath & wsh.Range("B" & i) & sExt
If sOldName <> "" Then
FileCopy sOldName, sNewName
Kill sOldName
End If
Loop
End Sub
Function FindFile(ByVal sDir As String, ByVal sFileName As String, Optional ByVal sFileExt As String = ".txt") As String
Dim retVal As String
If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
retVal = Dir(sDir & sFileName & sFileExt, vbNormal)
FindFile = retVal
End Function
Maciej Los
|
|
|
|
|
Dear all,
I'am trying to build a search program using Excel 2003 Macro, i have trouble when i click this command always shown this message : "Run Time Error '1004': Application-defined or object-defined error".
Need your help to check where the wrong syntax code of my program,
Private Sub cmdCari_Click()
Set wsDtbsCont = Sheets("DataContainer")
Set rgDtbsCont = wsDtbsCont.Range("DataContainer")
Set c = rgDtbsCont.Find(txtContNo.Value, LookIn:=xlValues)
txtCarrier.Value = c.Offset(0, 1).Value
cmbForwarder.Value = c.Offset(0, 2).Value
txtSeal.Value = c.Offset(0, 3).Value
txtStatus.Value = c.Offset(0, 4).Value
txtArrivalTime.Value = c.Offset(0, 5).Value
txtStuffingTime.Value = c.Offset(0, 6).Value
txtSealTime.Value = c.Offset(0, 7).Value
txtFreeTime.Value = c.Offset(0, 8).Value
txtOverNight.Value = c.Offset(0, 9).Value
End Sub
thank you for every things..
Best Regards,
Ahmad Rifai Yusuf
|
|
|
|
|
The range definition looks stange to me, can you use select all or something like that? I m assuming that your sheet actually excist though, or?
|
|
|
|
|
Dear Kenneth,
The sheet actually exist, i'am trying to search data with cmdCari Command Button with where the key is in txtContNo Text Box,
Actually i was interested use select or other SQL Statement, but don't have any references. Do you / any guys have it. Coz i really need it
Best Regards,
Ahmad Rifai Yusuf
|
|
|
|
|
sorry if my English is not good.
5 Days need to set name is :
Day1 = Legi
Day2 = Pahing
Day3 = Pon
Day4 = Wage
Day5 = Kliwon
I have the Code in VB6 with 1 form and 2 modules and I have no problem with it, but when i try to put this code on VB 2010 I completely have HEADACHE CODE
'Form1
------
Dim ahari
Dim shari As String
Dim l As Single
Dim l1 As Single
Dim CekTanggal As Boolean
Dim HariIni As Boolean
Public TextTanggalSekarang As String
Const MaxTahun = 2099, MinTahun = 1901
Private Sub CmbTahun_Click()
If CekTanggal = False Then
Exit Sub
End If
TampilkanTanggal
End Sub
Private Sub CmbBulan_Click()
If CekTanggal = False Then
Exit Sub
End If
TampilkanTanggal
End Sub
Private Sub Form_Load()
If App.PrevInstance = True Then
Unload Me
End
End If
CekTanggal = False
Combo_Status_Load
Combo_Tahun_Load
TanggalSekarang = Now
CmbBulan.ListIndex = Month(TanggalSekarang) - 1
CmbTahun.ListIndex = Year(TanggalSekarang) - MinTahun
HariIni = True
TampilkanTanggal
CekTanggal = True
formloaded = True
Timer1.Interval = 300
ahari = Array("Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu")
End Sub
Private Sub Combo_Status_Load()
CmbBulan.List(0) = "Januari"
CmbBulan.List(1) = "Februari"
CmbBulan.List(2) = "Maret"
CmbBulan.List(3) = "April"
CmbBulan.List(4) = "Mei"
CmbBulan.List(5) = "Juni"
CmbBulan.List(6) = "Juli"
CmbBulan.List(7) = "Agustus"
CmbBulan.List(8) = "September"
CmbBulan.List(9) = "Oktober"
CmbBulan.List(10) = "November"
CmbBulan.List(11) = "Desember"
End Sub
Private Sub Combo_Tahun_Load()
Dim i As Integer
For i = 0 To MaxTahun - MinTahun
CmbTahun.List(i) = i + MinTahun
Next
End Sub
Private Sub Grid_Kalender_Load()
Dim i As Integer
CalGrid.Row = 0
CalGrid.Col = 0
CalGrid.CellAlignment = 4
CalGrid.CellFontBold = True
CalGrid.CellBackColor = &HC0C0FF
For i = 1 To 6
CalGrid.Row = 0
CalGrid.Col = i
CalGrid.CellAlignment = 4
CalGrid.CellFontBold = True
CalGrid.CellBackColor = &HD4D4D4
Next
CalGrid.TextMatrix(0, 0) = "Min"
CalGrid.TextMatrix(0, 1) = "Sen"
CalGrid.TextMatrix(0, 2) = "Sel"
CalGrid.TextMatrix(0, 3) = "Rab"
CalGrid.TextMatrix(0, 4) = "Kam"
CalGrid.TextMatrix(0, 5) = "Jum"
CalGrid.TextMatrix(0, 6) = "Sab"
End Sub
Private Sub TampilkanTanggal()
Dim BanyakTanggal As Integer
Dim TahunTampil As Integer
Dim CekKabisat As Boolean
Dim HariPertama As Integer
Dim BulanTampil As Integer
Dim a As Long
Dim b As Long
Dim i As Integer
TanggalSekarang = Now
TanggalSekarang = Day(TanggalSekarang)
For a = 1 To 6
For b = 0 To 6
CalGrid.Row = a
CalGrid.Col = b
CalGrid.Clear
Next b
Next a
Grid_Kalender_Load
BulanTampil = CmbBulan.ListIndex + 1
TahunTampil = CmbTahun.ListIndex + MinTahun
HariPertama = Program_HariPertama(BulanTampil, TahunTampil)
CekKabisat = Program_CekKabisat(TahunTampil)
If BulanTampil = 4 Or BulanTampil = 6 Or BulanTampil = 9 Or BulanTampil = 11 Then
BanyakTanggal = 30
ElseIf (BulanTampil = 2 And CekKabisat = True) Then
BanyakTanggal = 29
ElseIf (BulanTampil = 2 And CekKabisat = False) Then
BanyakTanggal = 28
Else
BanyakTanggal = 31
End If
Dim HariPertamaJawa As Integer
Dim HariJawa As Integer
Dim TahunTampil_temp As Integer
If (TahunTampil > 2000) Then
TahunTampil_temp = TahunTampil - 100
Else
TahunTampil_temp = TahunTampil
End If
If (CekKabisat = True) Then
HariPertamaJawa = Program_HariJawaKabisat(BulanTampil, TahunTampil_temp)
Else
HariPertamaJawa = Program_HariJawaBiasa(BulanTampil, TahunTampil_temp)
End If
HariJawa = HariPertamaJawa
a = 1
b = HariPertama - 1
For i = 1 To BanyakTanggal
CalGrid.Row = a
CalGrid.Col = b
CalGrid.CellAlignment = 4
CalGrid.WordWrap = True
If (HariIni = True And i = TanggalSekarang) Then
CalGrid.CellBackColor = &HE0E0E0
TextTanggalSekarang = GetNamaHari(b + 1) & " " & NamaJawa(HariJawa) & "," & i & " " & CmbBulan.List(CmbBulan.ListIndex) & " " & TahunTampil
End If
CalGrid.Text = i & vbNewLine & NamaJawa(HariJawa)
If (HariJawa = 5) Then
HariJawa = 1
Else
HariJawa = HariJawa + 1
End If
If (b = 6) Then
a = a + 1
b = -1
End If
b = b + 1
Next
HariIni = False
End Sub
Private Sub SysTrayBtn_Click()
Me.Hide
Dim nid As NOTIFYICONDATA
With nid
.cbSize = Len(nid)
.hWnd = FormMain.hWnd
.uID = 0
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = 1400
.hIcon = FormMain.Icon
.szTip = TextTanggalSekarang & vbNullChar
End With
Shell_NotifyIconA NIM_ADD, nid
oldproc = SetWindowLongA(Me.hWnd, -4, AddressOf proc)
Me.Hide
End Sub
Private Sub Form_Paint()
formloaded = True
End Sub
Private Sub KalenderTray_Click()
Dim nid As NOTIFYICONDATA
With nid
.hWnd = Me.hWnd
.cbSize = Len(nid)
.uID = 0
End With
Shell_NotifyIconA NIM_DELETE, nid
SetWindowLongA Me.hWnd, -4, oldproc
Me.Show
Form_Load
End Sub
Private Sub Timer1_Timer()
shari = ahari(Abs(Weekday(Date) - 1))
Label5(1).Caption = "" & shari & ", " & Format(Date, "dd mmmm yyyy")
Label4(1).Caption = Format(Time, "hh:mm:ss")
End Sub
'Module1
--------
Function Program_CekKabisat(TahunTampil As Integer) As Boolean
Dim ModHasil As Integer
Dim CekKabisat As Boolean
ModHasil = TahunTampil Mod 4
If ModHasil = 0 Then
ModHasil = TahunTampil Mod 100
If ModHasil = 0 Then
ModHasil = TahunTampil Mod 400
If ModHasil = 0 Then
CekKabisat = True
Else
CekKabisat = False
End If
Else
CekKabisat = True
End If
Else
CekKabisat = False
End If
Program_CekKabisat = CekKabisat
End Function
Function Program_HariPertama(BulanTampil As Integer, TahunTampil As Integer) As Integer
Dim TanggalPertama As Date
TanggalPertama = CDate(Format(BulanTampil & "/01/" & TahunTampil, "mm/dd/yyyy"))
Program_HariPertama = Weekday(TanggalPertama)
End Function
Function Program_HariJawaKabisat(BulanTampil As Integer, TahunTampil As Integer) As Integer
Dim ModHasil As Integer
Dim JanKabisat As Integer
ModHasil = TahunTampil Mod 5
If (ModHasil = 0) Then
JanKabisat = 1
End If
If (ModHasil = 4) Then
JanKabisat = 2
End If
If (ModHasil = 3) Then
JanKabisat = 3
End If
If (ModHasil = 2) Then
JanKabisat = 4
End If
If (ModHasil = 1) Then
JanKabisat = 5
End If
If (BulanTampil = 1) Then
Program_HariJawaKabisat = JanKabisat
End If
Dim i As Integer
Dim jumlah As Integer
Dim BanyakTanggal As Integer
jumlah = 0
If (BulanTampil > 1) Then
For i = 1 To BulanTampil - 1
If i = 4 Or i = 6 Or i = 9 Or i = 11 Then
BanyakTanggal = 30
ElseIf (i = 2) Then
BanyakTanggal = 29
Else
BanyakTanggal = 31
End If
jumlah = jumlah + BanyakTanggal
Next i
ModHasil = jumlah Mod 5
Program_HariJawaKabisat = ModHasil + JanKabisat
If (Program_HariJawaKabisat > 5) Then
Program_HariJawaKabisat = Program_HariJawaKabisat - 5
End If
End If
End Function
Function NamaJawa(hari As Integer) As String
If (hari = 1) Then NamaJawa = "Legi"
If (hari = 2) Then NamaJawa = "Pahing"
If (hari = 3) Then NamaJawa = "Pon"
If (hari = 4) Then NamaJawa = "Wage"
If (hari = 5) Then NamaJawa = "Kliwon"
End Function
Function Program_HariJawaBiasa(BulanTampil As Integer, TahunTampil As Integer) As Integer
Dim i As Integer
Dim a As Boolean
Dim JanKabisat
For i = 1 To 3
a = Program_CekKabisat(TahunTampil + i)
If (a = True) Then
JanKabisat = Program_HariJawaKabisat(1, TahunTampil + i)
Exit For
End If
Next
If (BulanTampil = 1) Then
Program_HariJawaBiasa = JanKabisat
End If
Dim jumlah As Integer
Dim BanyakTanggal As Integer
jumlah = 0
If (BulanTampil > 1) Then
For i = 1 To BulanTampil - 1
If i = 4 Or i = 6 Or i = 9 Or i = 11 Then
BanyakTanggal = 30
ElseIf (i = 2) Then
BanyakTanggal = 28
Else
BanyakTanggal = 31
End If
jumlah = jumlah + BanyakTanggal
Next i
ModHasil = jumlah Mod 5
Program_HariJawaBiasa = ModHasil + JanKabisat
If (Program_HariJawaBiasa > 5) Then
Program_HariJawaBiasa = Program_HariJawaBiasa - 5
End If
End If
End Function
Function GetNamaHari(hari As Integer) As String
If (hari = 1) Then GetNamaHari = "Minggu"
If (hari = 2) Then GetNamaHari = "Senin"
If (hari = 3) Then GetNamaHari = "Selasa"
If (hari = 4) Then GetNamaHari = "Rabu"
If (hari = 5) Then GetNamaHari = "Kamis"
If (hari = 6) Then GetNamaHari = "Jumat"
If (hari = 7) Then GetNamaHari = "Sabtu"
End Function
'Sys Try
----------
Public Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function Shell_NotifyIconA Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public formloaded As Boolean
Public oldproc As Long
Public Function proc&(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
If Msg = 1400 And (lParam = 517 Or lParam = 515) And formloaded Then FormMain.PopupMenu FormMain.mnu
proc = CallWindowProcA(oldproc, hWnd, Msg, wParam, lParam)
End Function
|
|
|
|
|
Do you try to calculate the name of the day both in Bahasa Indonesia and in the Javanese Pasaran cycle?
For the 7 day week of Bahasa Indonesia, you should use the DayOfWeek property of a DateTime object.
The Javanese Pasaran week is different. You need to get the number of days since some minimum date, and then get the remainder of division by 5, that translates then to the Pasaran cycle.
That means: write your application from scratch, get rid of the old VB6 code.
|
|
|
|
|
Hi Bernarad
Thanks a lot to answering my questions.
I newbie in VB 2010, and that is my problem 
After analyzing and comparing; i see so many difference language between VB6 and VB2010. That's why i agree with your opinion about "get rid of the old vb6 code" and write my application from scratch.
Would be more grateful, if you are willing to give me some examples about; dayOfWeek property and a DateTime object in VB 2010.
Regards
(annoergenetica@live.com)
|
|
|
|
|
|
How to set
Day1 As Legi
Day2 As Pahing
Day3 As Pon
Day4 As Wage
Day5 As Kliwon
Day6 = back to Legi
Day7 As pahing
Day8 As Pon
and so on......
|
|
|
|
|
Hi guys,
I'm developping a Word 2010 macro to get an extended wordcount.
Briefly said, the word macro needs to do 2 things: gather wordcount stats, but including and excluding hidden text and get seperate word counts for texts in main body, headers & footers, shapes, ...
Detailed statistics would be saved to a new Word document. Lay-out etc would be no problem.
There is however a big issue. A lot of the documents that has to be processed are made with Word 2007 or even Word 2003 and earlier. When these documents contain (classic) Word Arts, I can't detect them (they're not in ActiveDocument.Shapes).
How do I:
* read the text from the Word Art?
* take a wordcount from the Word Art text (everything else uses Range.ComputeStatistics(), so I would like to use it as well - eventually creating a temporary range)
* copy the Word Art document to the new document, adding a reference to the page it is on (something like "Word Art on page 5)?
Thanks in advance you guys
Cheers!
modified 8-Apr-13 3:52am.
|
|
|
|
|
This sounds very complicated, and I have managed to access shapes in both 2007 and 2003 version before, but I dont think that would help you much.
I think it would be better if you asked this question on the VSTO forum over at microsoft. http://social.msdn.microsoft.com/Forums/en-US/vsto/[^]. They are regularly responded by MVP in the Office interop area.
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
